Leaderboard

If you look at my multi getvals.lsp it is a library program using normal DCl and no need for a custom dcl needs only 2 code lines to make the dcl. You make the list to suit from 1 to about 20 values can be entered, default values can be set or values remembered when ran again. Multi GETVALS.lsp (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm (list "Enter values " "X change " 5 4 "0" "Y change " 5 4 "0" "Z change" 5 4 "0"))) (setq xyz (list (atof (nth 0 ans))(atof (nth 1 ans))(atof (nth 2 ans)))) (command "_.move" ss "" "_non" '(0. 0. 0.) "_non" xyz) I stayed away from Opendcl even though its a great program, if doing external work its one more program a client must load and at times that can be a nightmare.

Sorry wasn't trying to make fun. usually when ppl use chatgpt their variable names and functions get extremely long/specific. guess that is the same for opendcl. That uses the VBA user forums but then encrypts the dcl file? (not very open) 2nd what BIGAL said alwasy try to encoperate the dcl file into my lisp so it makes a temp dcl file. one less thing to keep track of/get lost.

(vl-load-com) (defun c:wrap ( / acdoc *error* oldcmdecho ss0 ssl0 index ent bb ss ssl ptlist elist pt1 ptlist chlist chent textflag obj box lll url ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq oldcmdecho (getvar 'cmdecho)) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (vla-EndUndoMark acdoc) (setvar 'cmdecho oldcmdecho) (princ) ) (defun LWPolybylist (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (vla-StartUndoMark acdoc) (setvar 'cmdecho 0) (setq ss0 (ssget)) (setq ssl0 (sslength ss0)) (setq index 0) (setq textflag 0) (setq ptlist '()) (repeat ssl0 (setq ent (ssname ss0 index)) (setq elist (entget ent)) (if (or (eq (cdr (assoc 0 elist)) "TEXT") (eq (cdr (assoc 0 elist)) "MTEXT") (eq (cdr (assoc 0 elist)) "INSERT")) (progn (setq textflag 1) (setq obj (vlax-ename->vla-object ent)) (setq box (vla-getboundingbox obj 'll 'ur)) (setq lll (vlax-safearray->list ll)) ; lower left point (setq url (vlax-safearray->list ur)) ; upper right point (setq ent (LWPolybylist (list lll (list (car url) (cadr lll)) url (list (car lll) (cadr url))) 1)) ) (progn ) ) (setq ptlist (append (LM:ent->pts ent 100) ptlist)) ;(command "_.DIVIDE" ent 100 "") (if (= textflag 1) (entdel ent) ) (setq textflag 0) (setq index (+ index 1)) ) (setvar 'cmdecho oldcmdecho) (setq bb (LM:ssboundingbox ss0)) ;(if (setq ss (ssget "_C" (car bb) (cadr bb) '((0 . "POINT")))) ; (progn ; (setq ssl (sslength ss)) ; (setq index 0) ; (repeat ssl ; (setq ent (ssname ss index)) ; (setq elist (entget ent)) ; (setq pt1 (cdr (assoc 10 elist))) ; (setq ptlist (cons pt1 ptlist)) ; (entdel ent) ; (setq index (+ index 1)) ; ) ; ) ;) ;(princ ptlist) (setq chlist (LM:ConvexHull ptlist)) (setq chent (entmakex (append (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length chlist)) '(070 . 1) ) (mapcar '(lambda ( x ) (cons 10 x)) chlist) ) ) ) (vla-EndUndoMark acdoc) (princ) ) ;; Convex Hull - Lee Mac ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points. (defun LM:ConvexHull ( lst / ch p0 ) (cond ( (< (length lst) 4) lst) ( (setq p0 (car lst)) (foreach p1 (cdr lst) (if (or (< (cadr p1) (cadr p0)) (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0))) ) (setq p0 p1) ) ) (setq lst (vl-sort lst (function (lambda ( a b / c d ) (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (< (distance p0 a) (distance p0 b)) (< c d) ) ) ) ) ) (setq ch (list (caddr lst) (cadr lst) (car lst))) (foreach pt (cdddr lst) (setq ch (cons pt ch)) (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt)) (setq ch (cons pt (cddr ch))) ) ) ch ) ) ) ;; Clockwise-p - Lee Mac ;; Returns T if p1,p2,p3 are clockwise oriented or collinear (defun LM:Clockwise-p ( p1 p2 p3 ) (< (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1))) ) 1e-8 ) ) ;; Selection Set Bounding Box - Lee Mac ;; Returns a list of the lower-left and upper-right WCS coordinates of a ;; rectangular frame bounding all objects in a supplied selection set. ;; sel - [sel] Selection set for which to return bounding box (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq ls1 (cons (vlax-safearray->list llp) ls1) ls2 (cons (vlax-safearray->list urp) ls2) ) ) ) (if (and ls1 ls2) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ) ) ;; Entity to Point List - Lee Mac ;; Returns a list of WCS points describing or approximating the supplied entity, else nil if the entity is not supported. ;; ent - [ent] Entity name to be described by point list (POINT/LINE/ARC/CIRCLE/LWPOLYLINE/POLYLINE/ELLIPSE/SPLINE) ;; acc - [num] Positive number determining the point density for non-linear objects (defun LM:ent->pts (ent acc / ang bul cen cls di1 di2 enx inc itm lst num ocs rad tot typ vt1 vt2 vtl ) (setq enx (entget ent) typ (cdr (assoc 0 enx)) ) (cond ((= "POINT" typ) (list (cdr (assoc 10 enx))) ) ((= "LINE" typ) (mapcar '(lambda (x) (cdr (assoc x enx))) '(10 11)) ) ((or (= "ARC" typ) (= "CIRCLE" typ)) (if (= "ARC" typ) (setq ang (cdr (assoc 50 enx)) tot (rem (+ pi pi (- (cdr (assoc 51 enx)) ang)) (+ pi pi)) num (fix (+ 1.0 1e-8 (* acc (/ tot (+ pi pi))))) inc (/ tot (float num)) num (1+ num) ) (setq ang 0.0 tot (+ pi pi) num (fix (+ 1e-8 acc)) inc (/ tot (float num)) ) ) (setq cen (cdr (assoc 010 enx)) rad (cdr (assoc 040 enx)) ocs (cdr (assoc 210 enx)) ) (repeat num (setq lst (cons (trans (polar cen ang rad) ocs 0) lst) ang (+ ang inc) ) ) (reverse lst) ) ((or (= "LWPOLYLINE" typ) (and (= "POLYLINE" typ) (zerop (logand (logior 16 64) (cdr (assoc 70 enx)))) ) ) (if (= "LWPOLYLINE" typ) (setq vtl (LM:ent->pts:lwpolyvertices enx)) (setq vtl (LM:ent->pts:polyvertices ent)) ) (if (setq ocs (cdr (assoc 210 enx)) cls (= 1 (logand 1 (cdr (assoc 70 enx)))) ) (setq vtl (append vtl (list (cons (caar vtl) 0.0)))) ) (while (setq itm (car vtl)) (setq vtl (cdr vtl) vt1 (car itm) bul (cdr itm) lst (cons (trans vt1 ocs 0) lst) ) (if (and (not (equal 0.0 bul 1e-8)) (setq vt2 (caar vtl))) (progn (setq rad (/ (* (distance vt1 vt2) (1+ (* bul bul))) 4.0 bul) cen (polar vt1 (+ (angle vt1 vt2) (- (/ pi 2.0) (* 2.0 (atan bul)))) rad ) rad (abs rad) tot (* 4.0 (atan bul)) num (fix (+ 1.0 1e-8 (* acc (/ (abs tot) (+ pi pi))))) inc (/ tot (float num)) ang (+ (angle cen vt1) inc) ) (repeat (1- num) (setq lst (cons (trans (polar cen ang rad) ocs 0) lst) ang (+ ang inc) ) ) ) ) ) (reverse (if cls (cdr lst) lst)) ) ((= "ELLIPSE" typ) (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)) di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) di2 (- di2 1e-8) ) (while (< di1 di2) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatdist ent di1 ) ) ) di1 (+ di1 (/ di2 (1+ (fix (* acc (/ di2 rad (+ pi pi))))))) ) ) (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)) ) ) ((= "SPLINE" typ) (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)) di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) lst (list (vlax-curve-getstartpoint ent)) inc (/ (- di2 di1) (float acc)) di1 (+ di1 inc) ) (repeat (1- (fix (+ 1e-8 acc))) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) di1 (+ di1 inc) ) ) (reverse (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)) ) ) ) ) (defun LM:ent->pts:lwpolyvertices (enx / elv lst vtx) (setq elv (list (cdr (assoc 38 enx)))) (while (setq vtx (assoc 10 enx)) (setq enx (cdr (member vtx enx)) lst (cons (cons (append (cdr vtx) elv) (cdr (assoc 42 enx))) lst) ) ) (reverse lst) ) (defun LM:ent->pts:polyvertices (ent / lst vte vtx) (setq vte (entnext ent) vtx (entget vte) ) (while (= "VERTEX" (cdr (assoc 0 vtx))) (setq lst (cons (cons (cdr (assoc 10 vtx)) (cdr (assoc 42 vtx))) lst) vte (entnext vte) vtx (entget vte) ) ) (reverse lst) ) this routine wraps edges together rather than connecting right angle extension lines, so it may not suit your purpose..... so this is just for reference. I personally used this when I wanted to combine separate areas while using UNION for REVCLOUD command.

I thought that 2023 Autocad improved the extend, trim command to do what you want ? I don't have 2023. A custom lisp probably already exists do some googling, need a line intersects another line, adjust end points. Plines similar so long as no extra points between end and trim line. Extend is ok.

This one is what you want by Lee I use it various programs regarding to strings with numbers. Example code at end. ;;-------------------=={ Parse Numbers }==--------------------;;` ;; ;; ;; Parses a list of numerical values from a supplied string. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; s - String to process ;; ;;------------------------------------------------------------;; ;; Returns: List of numerical values found in string. ;; ;;------------------------------------------------------------;; (defun LM:ParseNumbers ( s ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar (function (lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) ) (cons nil l) l (append (cdr l) (list nil)) ) ) ")" ) ) ) (vl-string->list s) ) ) (defun c:wow ( / num1ent num2ent num1str num2str diff tstr) (setq num1ent (entget (car (entsel "\npick 1st text ")))) (setq num1str (cdr (assoc 1 num1ent))) (setq num1 (car (LM:ParseNumbers num1str ))) (setq num2ent (entget (car (entsel "\npick 2nd text")))) (setq num2str (cdr (assoc 1 num2ent))) (setq num2 (car (LM:ParseNumbers num2str ))) (setq diff (- num1 num2)) (setq tstr (strcat "IL " (rtos diff 2 2))) (entmod (subst (cons 1 tstr) (assoc 1 num2ent) num2ent)) (princ) ) (c:wow)

https://www.theswamp.org/index.php?topic=3517.msg391379#msg391379 you can start with this

Post your LISP as well, it might only need a simple modification