Leaderboard

Here's a simpe solution that doesn't use LISP. Change the elevation of one of the polylines to 1.0 then use the loft command to create asurface. Section the resulting surface with an XY plane at 0,0,0.5.

I guess you could do like (setq i (+ i 0.01)) 16 vertex poly would then create a 1600 vertex poly And then run overkill on the created polyline to remove all collinear vertexes.

You can try if this works better. No dbx in this version Start app , make selection , select drawing you want to paste in later. This drawing is shortly opened (not sure if it works if drawing is already open) List with blocknames is created and drawing is closed. Blocknames are compared and if duplicates are found message is displayed. You can choose 1- Stop , 2 - Rename the blocks in drawing you made the selection set (not the other drawing), or 3 - copy / paste as it is. Only thing left to do is select your basepoint (or replace 'pause' with "0,0" in the code) and selection set is placed on clipboard , ready to paste. ;;; check before paste - rlx 2025-10-22 (defun c:cbp ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames dbx-doc) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Drawing to check before you paste" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-other-dwg (Get_EX_Blocknames other-dwg))) (setq blocknames-in-other-dwg (mapcar 'strcase blocknames-in-other-dwg))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (setq inp (cfl (list "1 - I'm not gonna paste" "2 - Rename blocks before pasting" "3 - I'm gonna paste anyway"))) (cond ((or (void inp) (wcmatch inp "1*")) (alert "Copybase aborted")) ((wcmatch inp "2*")(foreach b duplicate-blocknames (rename_block_definition b)) (princ "\nBlocks are renamed - select your basepoint now") (command "_copybase" pause ss "")) ((wcmatch inp "3*") (princ "\nBlock names unchanged - select your basepoint now")(command "_copybase" pause ss "")) (t (princ"\nBite me...")) ) ) (progn (princ "\nNo duplicate block names found - select your basepoint")(command "_copybase" pause ss "")) ) ) ) (princ) ) ;;; get block names active doc - vanilla (defun _bl ( / b l ) (while (setq b (tblnext "BLOCK" (null b))) (if (zerop (boole 1 21 (cdr (assoc 70 b)))) (setq l (cons (cdr (assoc 2 b)) l)))) l) (defun Get_EX_Blocknames (other-dwg / fn l) (if (and (eq (type other-dwg) 'STR)(setq fn (findfile other-dwg)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) fn))) (progn (setq l (GetDocBlockNames doc))(vla-close doc)(vlax-release-object doc))) l) ;;; test (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetDocBlockNames ( d / b n l) (vlax-for b (vla-get-blocks d) (if (and (= :vlax-false (vla-get-isxref b)) (= :vlax-false (vla-get-islayout b)) (not (vl-string-search "*" (setq n (vla-get-name b)))))(setq l (cons n l)))) l) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bc bn ) (setq bc (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn bc)(setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss)(if (and (setq n (block-n o))(not (member n l)))(setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun void (x) (or (eq x nil)(and (listp x)(not (vl-consp x)))(and (eq 'STR (type x))(eq "" (vl-string-trim " \t\r\n" x))))) (defun block-n (o)(if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName) (vla-Get-EffectiveName o) (vla-Get-Name o)) nil)) (defun Collection-Member (m c / r) (if (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vla-item (list c m)))) nil r)) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil))) edit : just had an idea , why not open the 'to be pasted' drawing after you made your selection. Also tried if it was a bad thing if both drawings were already open and yes , that's bad... but then I'm a bad bad dragon (it still opens but as read only) Because I use vla-activate at the end , all lisp stops (obviously) Once drawings is activated you can copypaste / ctrl-V yourself (I'm sure as hell not comming to do that for you ) You decide what make you happy... ;;; check before paste 2 : after selection open the 'to be pasted' drawing - rlx 2025-10-22 (defun c:cbp2 ( / acDoc *docs* ss dbDoc blocknames-in-selectionset blocknames-in-dbDoc duplicate-blocknames inp do-it) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)) *docs* (vla-get-documents (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq dbDoc (getfiled "Drawing to check before you paste" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-dbDoc (Get_EX_Blocknames dbDoc))) (setq blocknames-in-dbDoc (mapcar 'strcase blocknames-in-dbDoc))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-dbDoc)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (setq inp (cfl (list "1 - I'm not gonna paste" "2 - Rename blocks before pasting" "3 - I'm gonna paste anyway"))) (cond ((or (void inp) (wcmatch inp "1*")) (alert "Copybase aborted")) ((wcmatch inp "2*")(foreach b duplicate-blocknames (rename_block_definition b)) (princ "\nBlocks are renamed - select your basepoint now") ;|(command "_copybase" pause ss "")|; (setq do-it t)) ((wcmatch inp "3*") (princ "\nBlock names unchanged - select your basepoint now") ;|(command "_copybase" pause ss "")|; (setq do-it t)) (t (princ"\nBite me...")) ) ) (progn (princ "\nNo duplicate block names found - select your basepoint") ;|(command "_copybase" pause ss "")|; (setq do-it t)) ) ) ) (if do-it (do_it)) ) (defun do_it ( / f d) (command "_copybase" pause ss "")(and (eq (type dbDoc) 'STR) (setq f (findfile dbDoc))(setq d (vla-open *docs* f)))(vla-activate d)) ;;; get block names active doc - vanilla (defun _bl ( / b l ) (while (setq b (tblnext "BLOCK" (null b))) (if (zerop (boole 1 21 (cdr (assoc 70 b)))) (setq l (cons (cdr (assoc 2 b)) l)))) l) (defun Get_EX_Blocknames (dbDoc / fn l) (if (and (eq (type dbDoc) 'STR)(setq fn (findfile dbDoc)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) fn))) (progn (setq l (GetDocBlockNames doc))(vla-close doc)(vlax-release-object doc))) l) ;;; test (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetDocBlockNames ( d / b n l) (vlax-for b (vla-get-blocks d) (if (and (= :vlax-false (vla-get-isxref b)) (= :vlax-false (vla-get-islayout b)) (not (vl-string-search "*" (setq n (vla-get-name b)))))(setq l (cons n l)))) l) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bc bn ) (setq bc (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn bc)(setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss)(if (and (setq n (block-n o))(not (member n l)))(setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun void (x) (or (eq x nil)(and (listp x)(not (vl-consp x)))(and (eq 'STR (type x))(eq "" (vl-string-trim " \t\r\n" x))))) (defun block-n (o)(if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName) (vla-Get-EffectiveName o) (vla-Get-Name o)) nil)) (defun Collection-Member (m c / r) (if (vl-catch-all-error-p (setq r (vl-catch-all-apply 'vla-item (list c m)))) nil r)) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil)))

For completeness, the key here is the "Repeat" option of the -INSERT command - though, I'm unsure in which version this relatively new keyword was introduced.

If you need more information, check the documentation on the CMDACTIVE system variable.

It won't - it will continue indefinitely until the user presses Esc to force it to exit.

Depending on your version of CAD, you can use this: (defun c:test ( ) (command "_.-insert" "yourblockname" "_s" 1 "_r" 0 "_re" "_y") (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\")) (princ) )

found this one under a layer of dust : ;;; https://lispbox.wordpress.com/2016/05/01/remove-any-unloaded-unreferenced-xrefsimagespdfsdgns-and-dwfs-in-a-one-click/ ;;; Remove any unloaded (unreferenced) XREFs,IMAGE's,PDF's,DGN's and DWF's in a one click ;;; Combined from existing subroutines by Igal Averbuh 2016 ;;; Based on https://www.theswamp.org/index.php?topic=51337.0 ;;; With respect to T.Willey ; Detach any unloaded (unreferenced) XREFs (defun C:dux () (vlax-for BIND_xrefname (vla-get-blocks (vla-get-ActiveDocument (vlax-get-Acad-object))) (if (= (vla-get-isxref BIND_xrefname) ':vlax-true) (progn (setq BIND_cont (entget (vlax-vla-object->ename BIND_xrefname)) BIND_cont (tblsearch "BLOCK" (cdr (assoc 2 BIND_cont))) ) (if (or (= (cdr (assoc 70 BIND_cont)) 4) (= (cdr (assoc 70 BIND_cont)) 12)) (vla-Detach BIND_xrefname) ) ) ) ) ) (defun c:RID ( / isDefReferenced dict data name tData lst imName ) ; Remove image definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_IMAGE_DICT") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " image definition(s).")) ) ) (princ) ) (defun c:RPD ( / isDefReferenced dict data name tData lst imName ) ; Remove pdf definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_PDFDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " pdf definition(s).")) ) ) (princ) ) (defun c:RDD ( / isDefReferenced dict data name tData lst imName ) ; Remove dgn definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_DGNDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " dgn definition(s).")) ) ) (princ) ) (defun c:RWD ( / isDefReferenced dict data name tData lst imName ) ; Remove dwf definition of unreferenced and unloaded definitions. (defun isDefReferenced ( aEname / cnt data ) (setq cnt 0) (foreach i (entget aEname) (if (and (equal (car i) 330) (setq data (entget (cdr i))) (= (cdr (assoc 0 data)) "IMAGEDEF_REACTOR") ) (foreach j data (if (and (equal (car j) 330) (entget (cdr j))) (setq cnt (+ cnt 1)) ) ) ) ) (> cnt 0) ) ;------------------------------------------------------- (setq dict (namedobjdict)) (setq data (entget dict)) (setq name "ACAD_DWFDEFINITIONS") (if (setq data (dictsearch dict name)) (foreach i data (cond ((and imName (equal (car i) 350)) ;check to see if unreferenced or unload (setq tData (entget (cdr i))) (if (or (equal (cdr (assoc 280 tData)) 0) (not (isDefReferenced (cdr i)))) (setq lst (cons (cons imName (cdr i)) lst)) ) ) ((equal (car i) 3) (setq imName (cdr i))) (t (setq imName nil)) ) ) ) (if lst (progn (setq dict (cdr (assoc -1 data))) (foreach i lst (dictremove dict (car i)) (entdel (cdr i)) ) (prompt (strcat "\n Removed " (itoa (length lst)) " dwf definition(s).")) ) ) (princ) ) (defun c:eid () (c:dux) (c:rid) (c:rpd) (c:rdd) (c:rwd) (vl-cmdf "_.externalreferences") (princ) ) (c:eid)

maybe something like this (untested) ;;; copy & paste for dummies - rlx 2025-10-18 (defun c:capfd ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Copy SS to:" "" "dwg" 0))) (progn (setq blocknames-in-selectionset (Get_SS_BlockNames ss)) (setq blocknames-in-other-dwg (Get_DBX_Blocknames other-dwg)) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") (if (yes_no "Copy anyway?") (ctd ss other-dwg) (princ"\nBite me...") ) ) (ctd ss other-dwg) ) ) ) (princ) ) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss) (if (and (block-p o)(not (member (setq n (block-n o)) l))) (setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) ; (block-p (vlax-ename->vla-object (car (entsel)))) (defun block-p (o) (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))) (defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) ; (yes_no "Do you like snow") (defun yes_no ( $m / f p i r ) (and (= (type $m) 'STR) (setq f (vl-filename-mktemp ".dcl")) (setq p (open f "w")) (write-line (strcat "yesno:dialog{label=\"" $m "?\";ok_cancel;}") p) (progn (close p)(gc) t) (setq i (load_dialog f)) (new_dialog "yesno" i) (progn (action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete f) t)(if (= r 1) t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) ; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) ; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...) (defun GetDocBlockNames (d / o n l) (vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))(= :vlax-false (vla-get-islayout o)) (snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))(if (vl-consp l)(acad_strlsort l))) (defun Get_DBX_Blocknames ( doc-name / lst v objectdbx-document) (cond ((not (eq (type doc-name) 'STR)) (princ (strcat "\nInvalid filename : " (vl-princ-to-string doc-name)))) ((not (findfile doc-name)) (princ (strcat "\nFile not found : " (vl-princ-to-string doc-name)))) (t (vlax-for doc (vla-get-Documents (vlax-get-acad-object)) (and (eq (strcase (vla-get-fullname doc)) (strcase doc-name))(setq objectdbx-document doc))) (cond ((eq (type objectdbx-document) 'VLA-OBJECT)) ((not (setq objectdbx-document (vlax-create-object (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))))) (princ "\nUnable to start object dbx")) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list objectdbx-document doc-name))) (princ (strcat "\nOdbx error - unable to acces : " doc-name))) (t (setq lst (GetDocBlockNames objectdbx-document))) ) ) ) (vl-catch-all-apply 'vla-close (list objectdbx-document :vlax-False)) (if (and (= 'vla-object (type objectdbx-document))(not (vlax-object-released-p objectdbx-document))) (vlax-release-object objectdbx-document)) (if (vl-consp lst) (mapcar 'strcase lst)) ) and if you want the rename version : ;;; copy for lazy dummies - rlx 2025-10-18 (defun c:cfld ( / this-dwg ss other-dwg blocknames-in-selectionset blocknames-in-other-dwg duplicate-blocknames) (setq this-dwg (vla-get-ActiveDocument (vlax-get-acad-object))) (if (and (setq ss (ssget)) (setq other-dwg (getfiled "Copy SS to:" "" "dwg" 0))) (progn (if (vl-consp (setq blocknames-in-selectionset (Get_SS_BlockNames ss))) (setq blocknames-in-selectionset (mapcar 'strcase blocknames-in-selectionset))) (if (vl-consp (setq blocknames-in-other-dwg (Get_DBX_Blocknames other-dwg))) (setq blocknames-in-other-dwg (mapcar 'strcase blocknames-in-other-dwg))) (setq duplicate-blocknames (compare_block_names blocknames-in-selectionset blocknames-in-other-dwg)) (if (vl-consp duplicate-blocknames) (progn (dplm duplicate-blocknames "Duplicated block names : ") ;;; (if (yes_no "Copy anyway?") (ctd ss other-dwg) (princ"\nBite me...") ) (if (yes_no "Rename duplicates?") (progn (foreach b duplicate-blocknames (rename_block_definition b)) (ctd ss other-dwg) ) (princ"\nBite me...") ) ) (ctd ss other-dwg) ) ) ) (princ) ) ; check if $member exists in (vla-) %collection (defun Collection-Member ( $member %collection / result) (if (vl-catch-all-error-p (setq result (vl-catch-all-apply 'vla-item (list %collection $member)))) nil result)) (defun create_unique_blockname ( $bn / i bn) (setq i 0)(while (tblsearch "block" (setq bn (strcat $bn "_" (itoa (setq i (1+ i))))))) bn) (defun rename_block_definition ( $bn / bn ) (if (and (not (void $bn)) (tblsearch "block" $bn)) (vla-put-name (Collection-Member $bn (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq bn (create_unique_blockname $bn)))) bn) (defun compare_block_names (a b / c) (and (vl-consp a) (vl-consp b) (foreach item a (if (member item b) (setq c (cons item c))))) c) (defun Get_SS_BlockNames ( ss / n l) (foreach o (ss->ol ss) (if (and (block-p o)(not (member (setq n (block-n o)) l))) (setq l (cons n l)))) l) (defun SS->OL (ss / i l)(setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) ; (block-p (vlax-ename->vla-object (car (entsel)))) (defun block-p (o) (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference"))) (defun block-n (o) (if (and (= 'vla-object (type O))(eq (vla-get-objectname O) "AcDbBlockReference")) (if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)) nil)) ; (yes_no "Do you like snow") (defun yes_no ( $m / f p i r ) (and (= (type $m) 'STR) (setq f (vl-filename-mktemp ".dcl")) (setq p (open f "w")) (write-line (strcat "yesno:dialog{label=\"" $m "?\";ok_cancel;}") p) (progn (close p)(gc) t) (setq i (load_dialog f)) (new_dialog "yesno" i) (progn (action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete f) t)(if (= r 1) t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; copy to drawing (defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array) (defun SS->OL (ss / i l) (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) (princ) ) ; test : (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) ; returns sorted list (uppercase) like : ("BLOCK_A" "BLOCK_B" ...) (defun GetDocBlockNames (d / o n l) (vlax-for o (vla-get-blocks d)(if (and (= :vlax-false (vla-get-isxref o))(= :vlax-false (vla-get-islayout o)) (snvalid (setq n (vla-get-name o)) 0))(setq l (cons (strcase n) l))))(if (vl-consp l)(acad_strlsort l))) (defun Get_DBX_Blocknames ( doc-name / lst v objectdbx-document) (cond ((not (eq (type doc-name) 'STR)) (princ (strcat "\nInvalid filename : " (vl-princ-to-string doc-name)))) ((not (findfile doc-name)) (princ (strcat "\nFile not found : " (vl-princ-to-string doc-name)))) (t (vlax-for doc (vla-get-Documents (vlax-get-acad-object)) (and (eq (strcase (vla-get-fullname doc)) (strcase doc-name))(setq objectdbx-document doc))) (cond ((eq (type objectdbx-document) 'VLA-OBJECT)) ((not (setq objectdbx-document (vlax-create-object (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))))) (princ "\nUnable to start object dbx")) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list objectdbx-document doc-name))) (princ (strcat "\nOdbx error - unable to acces : " doc-name))) (t (setq lst (GetDocBlockNames objectdbx-document))) ) ) ) (vl-catch-all-apply 'vla-close (list objectdbx-document :vlax-False)) (if (and (= 'vla-object (type objectdbx-document))(not (vlax-object-released-p objectdbx-document))) (vlax-release-object objectdbx-document)) (if (vl-consp lst) (mapcar 'strcase lst)) ) (c:cfld)

I think this code should meet what you need. ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:subTexta (/ e n le vlae txu tx cj g? tg) (vl-catch-all-apply '(lambda () (while (or (/= (setq tx (getstring (strcat "\nType TEXT to add to DIMENSION (escape to EXIT) " (if tx (strcat "<" tx ">") "") ": "))) "") txu) (set (if (= tx "") 'tx 'txu) (if (= tx "") txu tx)) (setq n nil cj (ssget "_:L" '((0 . "*DIMENSION")))) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq g? (/= (setq tg (vla-get-Textoverride (setq vlae (vlax-ename->vla-object e)))) "")) ;(vla-put-Textoverride vlae (if g? (strcat tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat tg "<>\\X" tx)));ACTIVA ESTA LÍNEA SI QUIERES EVITAR QUE PONGA EL SIGNO + DELANTE DEL PRIMER TEXTO Y DESACTIVA LA SIGUIENTE LÍNEA DE CODIGO (vla-put-Textoverride vlae (if g? (strcat (if (wcmatch tg "+*") "" "+") tg (if (wcmatch tg "*\\X*") "\n" "\\X") tx) (strcat "+" (rtos (vla-get-Measurement vlae) 2 (vla-get-PrimaryUnitsPrecision vlae)) "\\X" tx))) ) ) ) ) (princ) )

Since we're all going off topic (thanks a lot Bigal) , might as well join the band. Added the 'check before paste' lisp to my toolbar. Not sure if I'm ever gonna use it but that wasn't the point, was working on a way to make it a little more easier for myself to update the toolbars for my colleagues (the old last century toolbars , you oldies know what I mean) so lazy as I am , created a button for that too. It hasn't been field tested though so it may or may not work at all... New for me was the help part. Never used html in my life before and also read-write stream only used a couple of times (to create a few .bmp files for the toolbar by means of lisp , look for the Party button) So lets party yeah! euh ...the button I mean , what I mean by that , read the .... manual (oh just press the darn help button) Easy_Toolbar_Creator.lsp

I tracked the issue, pretty much what @mhupp stated, it just does it different depending on selection 1 and selection 2. I think at least part of that issue was using vlax-curve-getPointAtDist and/or vlax-curve-getClosestPointTo changes according to the first selection. Normally good enough for most people. I made headway trying to get the LISP working similar to your manual method, it's fairly good, the main issue is on some polylines, even with your method an actual decision on what is the best line(s) at certain spots is needed. The new LISP I worked on, seems to be pretty good no matter the selection order on all but the long rectangle shape. Working or not, I might go ahead and post what I have Monday when I return to work. I worked out manually why selection order on the one with the straight through the corner and reverse selection there is a little dogleg shape, there is a decision to be made there, I did it both ways and matched mine and Lee Mac's shape. It will be Monday when I get back to work before I have time to keep testing. I wish I had found Lee Mac's code, somehow I missed that one. I would have never made mine, for some reason those rolling ball LISPs never worked out very well for me.

So you don't need to create a list of each line of the file. If the file is large, it will waste a lot of time and consume resources. Simply load each line of the file directly as it's read.

I guess the solution is to programme how you currently do this - what is your manual method? As for a solution, haven't looked how SLW210 does his but might expand MHUPP to use both polylines and find the mid points using all verticies.

You can try this...I am not sure how accurate it will be for you, but 100-500 sample size looked pretty good on your drawing, you can change the default, but I kept it at 50 for myself. ;;; Draw a polyline centered between two selected polylines (can be dissimilar/irregular). ;;; ;;; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/#findComment-676800 ;;; ;;; By SLW210 (a.k.a. Steve Wilson) ;;; (defun c:DrawCl (/ pl1 pl2 num-pts len1 n dist step pt1 pt2 midpt pts) (vl-load-com) ;; Select first polyline (setq pl1 (car (entsel "\nSelect first polyline: "))) (if (not (and pl1 (= (cdr (assoc 0 (entget pl1))) "LWPOLYLINE"))) (progn (princ "\nInvalid first selection.") (exit)) ) ;; Select second polyline (setq pl2 (car (entsel "\nSelect second polyline: "))) (if (not (and pl2 (= (cdr (assoc 0 (entget pl2))) "LWPOLYLINE"))) (progn (princ "\nInvalid second selection.") (exit)) ) ;; Set number of sample points to use (it uses last number entered, default is 50) (if (not *CL_lastNumPts*) (setq *CL_lastNumPts* 50)) (setq num-pts (getint (strcat "\nEnter number of sample points <" (itoa *CL_lastNumPts*) ">: ") ) ) (if (null num-pts) (setq num-pts *CL_lastNumPts*)) (setq *CL_lastNumPts* num-pts) ;; Calculate (setq len1 (vlax-curve-getDistAtParam pl1 (vlax-curve-getEndParam pl1))) (setq step (/ len1 num-pts)) (setq dist 0.0 pts '() ) ;; Midpoint list (repeat (1+ num-pts) (setq pt1 (vlax-curve-getPointAtDist pl1 dist)) (setq pt2 (vlax-curve-getClosestPointTo pl2 pt1)) (if (and pt1 pt2) (setq pts (cons (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2) pts)) ) (setq dist (+ dist step)) ) ;; Create polyline (if pts (progn (setq pts (reverse pts)) (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 70 0) ) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) (princ "\nCenterline drawn accurately between polylines.") ) (princ "\nNo points generated — check polylines.") ) (princ) ) (princ "\nType DrawCl to draw a centerline between two polylines.") (princ) That said, I just tried Lee Mac's cPoly in mhupp's last link posted, seems to be similar results to mine if you adjust the sample points. I haven't checked the others yet, I'll run through them if I get time. I originally made mine with the command function, then changed it to entmake, pretty sure the accuracy is the same, it just had a lot of "Specify next point or [Arc/Close/Halfwidth/Length/Undo/Width]:" in the commandline for each sample. P.S. Mine should take into account reversed polylines. At the same sample size, mine and Lee Mac's seem to be exactly the same on your drawing. I still have to do on mine, set a layer and linetype option in the code.

in essence I took out the dbx stuf like : (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp)) (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver)))) (vla-open dbx dwg) ; put all block objects in a list (setq object-list (ss->ol ss)) ; put list with objects in a safe array (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list))))) (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list)) ; copy objects to dbx-drawing (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx)) (vl-catch-all-apply 'vla-saveas (list dbx dwg)) (vl-catch-all-apply 'vlax-release-object (list dbx)) (setq object-list nil object-safe-array nil) In lasted version I used : (defun Get_EX_Blocknames (dbDoc / fn l) (if (and (eq (type dbDoc) 'STR)(setq fn (findfile dbDoc)) (setq doc (vla-open (vla-get-documents (vlax-get-acad-object)) fn))) (progn (setq l (GetDocBlockNames doc))(vla-close doc)(vlax-release-object doc))) l) ;;; test (setq lst (GetDocBlockNames (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun GetDocBlockNames ( d / b n l) (vlax-for b (vla-get-blocks d) (if (and (= :vlax-false (vla-get-isxref b)) (= :vlax-false (vla-get-islayout b)) (not (vl-string-search "*" (setq n (vla-get-name b)))))(setq l (cons n l)))) l) instead of using (vla-open dbx dwg) I now used (vla-open (vla-get-documents (vlax-get-acad-object)) fn) using vla-open means you best only use vla- commands and never ever use vla-activate until the very last end because at that point lisp focus will end there and any code left with it. Lisp can only run in one document at the time , but when using vla- commands only it is possible to open and close other drawing and stil maintain lisp focus. Maybe not beginners stuf but me too only got where I am by beg steal & borrow code from others , change things an see what happens. This all costs time but having a wife with her own hobbies or not having a social life all helps

What version of GstarCAD are you using? Enhanced API in GstarCAD 2024 I would think anything that runs in AutoCAD LT would work, if I have time and @rlx doesn't get back, I'll try to look at them (I am curious about this). If you could carefully list out what happened with each code in AutoCAD and GstarCAD, it would help.

Yes I have draw a grid on a viewport, rotation is supported, may cost you a cup of coffee.

See what this does. https://www.cadtutor.net/forum/topic/14213-lisp-to-create-polyline-between-polylines/#findComment-117973

attout and attin?

I checked: it works on Autocad... on GstarCAD it doesn't work. It doesn't matter, I use your previous file that reported the error but didn't allow renaming (CAPFD) thank you so much RLX for your effort!

I think I've achieved a workaround. I'm going to set a macro within excel that exports the data to a CSV every time the excel document is saved (overwriting the existing versions). I'm then going to read this using the standard IO functions available to me in LT. It's not the cleanest solution, but I believe it should work. If anyone has any advice regarding pitfalls etc. that I might encounter please feel free to enlighten me

@Danielm103 Thank you for this, it looks really good. The problem is that I'm building this for people that are exceptionally resistant to change, and really I need a standalone lisp that can just be launched from within autocad and handles everything. If there is any more complexity to it than that, then it simply wont even be considered for adoption @Steven P Thanks for the info, I'll take a look this evening once I've got my actual work out of the way for the day

Select both polylines find the polyline that has the most vertex Then process those vertex with vlax-curve-getClosestPointTo store the mid point of vertex and closest point in a list entmake new polyline with list points. Seems to work well tho will need to test if you have open or closed polylines. defaults to closed tho i don't think its quite the mid / avg path ;;----------------------------------------------------------------------------;; ;; CLOSE POLY AVERAGE, Finds the mid point avg between close polylines donut shape (defun c:CLOSEPOLYAVG (/ sel1 sel2 ent1 ent2 cnt1 cnt2 main other i ptv ptc mid pts) (defun c:CPA () (C:CLOSEPOLYAVG)) (defun midpt (p1 p2) (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2) ) (setq sel1 (entsel "\nSelect First close Polyline: ")) (setq sel2 (entsel "\nSelect Second closed Polyline: ")) (if (and sel1 sel2) (progn (setq ent1 (vlax-ename->vla-object (car sel1)) ent2 (vlax-ename->vla-object (car sel2)) cnt1 (fix (vlax-curve-getEndParam ent1)) cnt2 (fix (vlax-curve-getEndParam ent2)) ) (if (> cnt1 cnt2) (setq main ent1 other ent2) (setq main ent2 other ent1) ) (setq pts '()) (setq i 0) (while (<= i (fix (vlax-curve-getEndParam main))) (setq ptv (vlax-curve-getPointAtParam main i)) (setq ptc (vlax-curve-getClosestPointTo other ptv)) (setq mid (midpt ptv ptc)) (setq pts (append pts (list mid))) (setq i (1+ i)) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 1) ;; closed ) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) (princ "\nNew midpoint polyline created.") ) (princ "\nSelection error.") ) (princ) )

pltools.lsp centerPline.LSP

well , downloaded your files on my homedragon and no errors on my side , maybe others can give it a go and see if they get an error?

Posting a drawing would help to be more clear with what your asking for. but maybe this is what your looking for. PAV

Maybe this (defun c:guardAA (/ v nvoD f? v lv c n para substCad) (defun substCad (tx a n / c i r) (while (/= (setq c (substr tx (setq i (if i (1+ i) 1)) 1)) "") (setq r (strcat (if r r "") (if (= c a) n c)))) ) (vl-catch-all-apply '(lambda () (while (not para) (initget 1 (strcat (foreach v (list "R14" "2000" "2004" "2007" "2010" "2013" "2018") (setq c (strcat (if c c "") (if (and (not (assoc v lv)) (eval (read (strcat "ac" v "_dwg")))) (strcat v " ") "")))) "Continue")) (setq v (getkword (strcat "\rSelect versions [" (substCad (strcat c "Continue") " " "/") "]: "))) (if (= v "Continue") (setq para T) (setq lv (append lv (list (list v (eval (read (strcat "ac" v "_dwg")))))) c nil)) ) (setq f? (if (not (vl-directory-files (setq nvoD (strcat (getvar "DWGPREFIX") "EXPORTED\\")))) (VL-MKDIR nvoD) T)) (foreach v lv (vla-saveas (vla-get-activedocument (vlax-get-acad-object)) (strcat (if f? nvoD (getvar "DWGPREFIX")) (VL-FILENAME-BASE (setq n (if n n (getvar "DWGNAME")))) "_v" (car v) ".dwg") (cadr v)) ) (princ (if lv "\nDone!" "\nNothing to do")) ) ) (princ) ) PS: Untested

If it is just a stand alone action, this will work but you have to escape out of it to cancel - you cannot have more to the routine, so stand alone only (while (= (command "-INSERT" GV-Block pause "" "" "0") nil) ) or this (while (setq pt1 (getpoint "Press LH Mouse to repeat, Enter / Space cancel")) (= (command "-insert" "circuitBreaker" pause 1 1 0) nil) )

@Ish, if you don't mind, can you please attach video, gif, picture, etc. of the problem which you issued, because I'm not sure to fully understand the problem. Thanks

Another By @Lee Mac Area.lsp look on his web site. https://www.lee-mac.com/arealabel.html

Hi It's not certain that all the functions in this code will work in AutoCAD LT. Try it. (defun c:guardA (/ v nvoD f?) (setq v (member (vla-get-saveAsType (vla-get-openSave (vla-get-preferences (vlax-get-acad-object)))) (list acr14_dwg "v14" ac2000_dwg "v2000" ac2004_dwg "v2004" ac2007_dwg "v2007" ac2010_dwg "v2010" ac2013_dwg "v2013" ac2018_dwg "v2018"))) (setq f? (if (not (vl-directory-files (setq nvoD (strcat (getvar "DWGPREFIX") "EXPORTED\\")))) (VL-MKDIR nvoD) T)) (vla-saveas (vla-get-activedocument (vlax-get-acad-object)) (strcat (if f? nvoD (getvar "DWGPREFIX")) (VL-FILENAME-BASE (getvar "DWGNAME")) "-EXPORTED_" (cadr v) ".dwg") (car v)) (princ "\nDone!") (princ) )

Here are two good options from Lee Mac

You're welcome!

I do same as Steven P with 1 little change (if (< pre 10)(setq tmp "00"))

I use Bricscad and Acad so maybe do the set check twice. Sub PTEXT() On Error Resume Next Dim app As Object, Doc As Object On Error Resume Next Set app = GetObject(, "BricscadApp.AcadApplication") 'Checks if BricsCAD is open probably have to change for AutoCAD. If app Is Nothing Then 'Checks if Autocad is open Set App = GetObject(, "AutoCAD.Application") End If If app Is Nothing Then MsgBox "BriscCAD / Autocad isns't Open!", vbCritical, "Output Error" Else: MsgBox "Cad found" Exit Sub End If End Sub app twice

Hi, Here is another version of the rolling ball by the bisection method. Part of the code is from Lee-Mac, thank you. The code does not work for any curves and in the case presented in jpg you must first select the upper curve then the lower one (line). ; Mid of the two curves, method rolling ball ; Part of the code is from Lee-Mac (thank you) ; 2020-05-28 = Roy437 = (vl-load-com) (defun c:mc ( / *error* a b c d1 d2 dis ds ent1 ent2 eps len_ent1 p1 p2 pp sel tmp ) (setvar 'CMDECHO 0) (setvar 'OSMODE 0) (setq eps 0.0001) (command "color" 3) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (if (not (and (setq ds (getenv "LMac\\dist")) (setq ds (atof ds)) (< 0 ds) ) ) (setenv "LMac\\dist" (rtos (setq ds 1.0))) ) (if (setq sel (ssget "_:L" '( (0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE") (-4 . "<NOT") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&") (70 . 88) (-4 . "AND>") (-4 . "NOT>") ) ) ) (progn (initget 4) (if (setq tmp (getreal (strcat "\nSpecify length of arc(ds) <" (rtos ds) ">: "))) (setenv "LMac\\dist" (rtos (setq ds tmp))) ) (LM:startundo (LM:acdoc)) (setq ent1 (ssname sel 0) ent2 (ssname sel 1) dis 0.0 len_ent1 (vlax-curve-getdistatparam ent1 (vlax-curve-getendparam ent1)) ) (command "pline") (while (< dis len_ent1) (if (setq p1 (vlax-curve-getpointatdist ent1 dis)) (progn (setq p2 (vlax-curve-getClosestPointTo ent2 p1) a p2 b p1 d1 0.0 d2 1.0 ) ; Bisection method ; --------------------------------------------------------------------- (while (> (abs (- d2 d1)) eps) (setq c (midp a b) pp (vlax-curve-getClosestPointTo ent1 c) d1 (distance c pp) d2 (distance c p2) ) (if (< d1 d2) (setq b c) (setq a c) ) ) ; --------------------------------------------------------------------- (command c) ) ) (setq dis (+ dis ds)) ) (command) (LM:endundo (LM:acdoc)) ) ) (princ) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Midpoint - Lee Mac ;; Returns the midpoint of two points (defun midp ( a b ) (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b) ) (princ "\nMC") (princ) I'm waiting for comments.

Try to use eTransmit instead. That usually always works even when I get errors such as these.

Had a bit of time, so heres an animated version (defun c:cPoly (/ ent1 ent2 i j mPt len pt p1 ptlst grlst grlin) (vl-load-com) (if (and (setq ent1 (car (entsel "\nSelect First Polyline: "))) (wcmatch (cdr (assoc 0 (entget ent1))) "*POLYLINE")) (if (and (setq ent2 (car (entsel "\nSelect Second Polyline: "))) (wcmatch (cdr (assoc 0 (entget ent2))) "*POLYLINE")) (progn (setq i -1 len (/ (vla-get-Length (vlax-ename->vla-object ent1)) 100.) grlin '( )) (while (and (grread 't) (setq pt (vlax-curve-getPointatDist ent1 (* (setq i (1+ i)) len)))) (redraw) (setq p1 (vlax-curve-getClosestPointto ent2 pt t) ptlst (cons (setq mPt (polar pt (angle pt p1) (/ (distance pt p1) 2.))) ptlst) j -1 grlst nil) (repeat 500 (setq grlst (cons (polar mPt (* (setq j (1+ j)) (/ pi 250.)) (distance mPt p1)) grlst))) (setq grlin (append grlin (list (if grlin (last grlin) mPt) mPt))) (grvecs (append '(3) grlst (cdr grlst) (list (car grlst)))) (grvecs (append '(1) grlin))) (redraw) (setq ptlst (apply 'append (mapcar (function (lambda (x) (list (car x) (cadr x)))) ptlst))) (vla-AddLightWeightPolyline (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-VBDouble (cons 0 (1- (length ptlst)))) ptlst)))))) (princ)) Enjoy! Lee