Leaderboard

Where layer transparency is concerned, this may be of interest - https://www.theswamp.org/index.php?topic=52473.msg574001#msg574001

;;; blocks in group (defun c:big ( / gl ) (vl-load-com) (if (not (vl-consp (setq gl (lag)))) (alert "Computer says no : there are no groups") ;;; show all blocks in group (choose from group list) (sabig (cfl gl)) ) (princ) ) ;;; list all groups (setq rtn (lag)) (defun lag ( / gps lst) (setq gps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for g gps (setq lst (cons (vla-get-name g) lst))) (if (vl-consp lst) (acad_strlsort lst)) ) ; 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))) ;;; 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)))) ; multiple association (defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l)) ;;; test if (vla) object is a block / get blockname / ename->vla-object (defun block-p (o) (and (setq o (e->o o)) (member (vla-get-objectname o) '("AcDbBlockReference" "AcDbBlockTableRecord")))) (defun block-n (o) (if (block-p o)(if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)))) (defun e->o (e) (cond ((= 'vla-object (type e)) e)((= 'ename (type e))(vlax-ename->vla-object e))(t nil))) ;;; show all blocks in group (defun sabig (gname / odic gdic grec el blist) (setq odic (namedobjdict)) (setq gdic (dictsearch odic "ACAD_GROUP")) (setq grec (dictsearch (cdar gdic) gname)) (setq el (massoc 340 grec)) (if (vl-consp el) (foreach x el (if (block-p x)(setq blist (cons (block-n (e->o x)) blist))))) (if (vl-consp blist) ;;; (dplm (acad_strlsort blist) (strcat "Blocks in group " gname)) (write-list blist) (alert (strcat "Computer says no : sorry no block in group " gname)) ) ) (defun write-list ( l / fn fp) (if (setq fp (open (setq fn (strcat (getvar "dwgprefix") "file1.txt")) "w")) (progn (foreach item l (write-line item fp)) (close fp) (gc) (gc) (startapp "notepad" fn) ) ) (princ) )

https://www.theswamp.org/index.php?topic=51248.msg563608#msg563608

Use entmakex. ; A 1000x500 rectangle with horizontal sides with a global width of 40, vertical sides with a global width of 0. (defun c:RectWidth-hor40 (/ pt1 pt2 hWidth vWidth p1 p2 p3 p4 pl) (setq width 1000 ; Rectangle width height 500 ; Rectangle height hWidth 40 ; Global width of horizontal sides vWidth 0) ; Global width of vertical sides (setq pt1 (getpoint "\nSpecify the insertion point: ")) (setq p1 pt1 p2 (list (+ (car pt1) width) (cadr pt1)) p3 (list (+ (car pt1) width) (+ (cadr pt1) height)) p4 (list (car pt1) (+ (cadr pt1) height))) (setq pl (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) (cons 10 p1) (cons 40 hWidth) (cons 41 hWidth) (cons 10 p2) (cons 40 vWidth) (cons 41 vWidth) (cons 10 p3) (cons 40 hWidth) (cons 41 hWidth) (cons 10 p4) (cons 40 vWidth) (cons 41 vWidth) ) ) ) (princ) )

solved it, instead of pt I put '(0.0 0.0 0.0) and it works.(pt and r are acquired at start of lisp) THANX again for ur help and guidance, and @Tharwat for his lisp that gave me idea

I really miss that guy. ;/ He was such a witty kind person and one of the most talented lisp programmers I knew.

I hate spending time correcting AI-generated code, but the first thing that sticks out is that the following: (setq attArray (vla-getattributes vlaBlock)) Will return a safearray variant, which cannot be iterated directly using foreach. Instead, you can use: (setq attArray (vlax-invoke vlaBlock 'getattributes)) Which will return the data using native data types, i.e. a list. You can find more examples here.

This function was originally written by the late great Michael Puckett - https://www.theswamp.org/index.php?topic=38072.0

PS: Someday you'll win one of those public tenders, and when that happens, I hope you'll come over here and have a coffee with one of us Good luck!

Hi @PGia I think this should meet your needs. I could say I wrote it from scratch just for you, but really, I also did it for myself. I had a good time revisiting old concepts. As I said, this is much easier to do with Map or Civil3D, creating topologies and manipulating them with the 'mnt*' functions. But writing this code has helped me prove that these tools can also be done in Lisp, with reasonably good results. The expressions are in my language. You'll have to translate them into yours. ;******************* G L A V C V S ******************* ;********************* F E C I T ********************* (defun c:spf>PGia (/ conj cj cjP ent n lstent en ex d pt i l lC lCs cE ltS ltV ltds s lSV actEtqs selR) (defun lSV (l / p r) (setq ltS (cons (list (setq s (vlax-ename->vla-object (car l))) (cadr l)) ltS) lCs (cons (list s (last l)) lCs)) (foreach x (reverse (cdr l)) (if p (if (not (member x ltds));ltds es la lista de los ya tocados (if (setq r (assoc p ltV)) (setq ltV (subst (list (car r) (+ (cadr r) (vla-get-area x))) r ltV) ltds (cons x ltds));ltV es una lista en que se asocia el identificador de las lineas contenedoras con la suma de la áreas de las contenidas (setq ltV (cons (list p (vla-get-area x)) ltV) ltds (cons x ltds)) ) ) ) (setq p x) ) ) (defun actEtqs (/ a b c e p pc l et tx) (foreach v (reverse ltS) (setq e (car v) p (cadr v) pc (last v)) (if (= (vla-get-layer e) "US") (setq l (cadr (assoc e lCs)) tx (vl-some '(lambda (x) (if (equal (cadr x) l) (vla-get-textstring (car x)))) ltS)) (setq tx nil) ) (if (/= (vla-get-layer e) "GEN") (vla-put-color p 6)) (vla-put-textstring e (strcat (if tx (strcat tx "-") "") (vla-get-textstring e) ":" (rtos (- (vla-get-area p) (if (setq a (assoc p ltV)) (cadr a) 0)) 2 2)) ) ) ) (defun selR (p / r s l lt en ex cj n o r4 f) (defun r2+ (p l r / i b) (vl-some '(lambda(g) (= 2 (setq r (if (foreach a (cons (last l) l) (if b (if (inters p (polar p g d) b (setq b a)) (setq i (not i))) (setq b a)) i) (+ r 1) r)))) '(0 1.5708 3.141592 4.71239) ) ) (if (setq cj (ssget "_F" (list p (list (car p) (+ (cadr p) (getvar "viewsize")))) (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)) ) ) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (if (r2+ p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))) 0) (progn (setq l (cons (vlax-ename->vla-object e) l)) (if (ssmemb e cjP) (ssdel e cjP))) ) ) ) (if l (vl-sort l '(lambda (a b) (< (vla-get-Area a) (vla-get-Area b))))) ) (setq en (getvar "extmin") ex (getvar "extmax") n -1 d (max (- (car ex) (car en)) (- (cadr ex) (cadr en))) ) (vla-zoomExtents (vlax-get-acad-object)) (setq cjP (ssget "x" (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)))) (if (setq conj (ssget "_X" '((0 . "TEXT") (8 . "GEN,US")))) (while (setq ent (ssname conj (setq n (1+ n)))) (setq lstent (entget ent) pt (cdr (assoc 10 lstent))) (if (setq l (selR pt)) (lSV (cons ent l)) (princ (strcat "\n*** Etiqueta " (cdr (assoc 1 lstent)) " huerfana"))) ) ) (if (> (sslength cjP) 0) (alert "ATENCION: Hay polilíneas sin asignar")) (alert (strcat "Numero de perímetros procesados: " (itoa (length ltS)))) (actEtqs) (princ) )

See attached code. 1. run the lisp in paper space. 2. the lisp prompt you to select a point on the block IN PAPER SPACE!! - click on the block. 3. click on the start point of the MLeader arrow - you are in paper space, no wories... 4. place the MLeader. 5. if you want to label another block go ahead. 6. to exit hit escape key or mouse right click. EDIT: the lisp works in model space as well. (defun c:MLeaderWBlname( / *error* temperr osnp tm tagname ptms ss ensel obj obj1 nam);ptps ptps1 (setq temperr *error*);store *error* (setq *error* trap1);re-assign *error* (setq osnp (getvar "OSMODE")) (setvar "OSMODE" 0) (setq tm (getvar "TILEMODE")) (princ "Select object in paper space,select start point of MLeader,exit with esc'") (while 1 (if (= tm 0);if in paper space (progn (getpoint) ;;get point in paper space on the target object (command "._MSPACE") (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space (setq ss (ssget ptms));;selction set of the object crossing the ptms point (setq obj(ssname ss 0)) (command "._PSPACE") );progn (progn ;in model space (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy (setq obj (car ensel)) ;set the block object to varaible );progn );if (setq obj1 (vlax-ename->vla-object obj)) (setq nam (vlax-get-property obj1 (if (vlax-property-available-p obj1 'effectivename) 'effectivename 'name ) ) ) (command "_mleader" "H" pause pause nam) );end while (setq *error* temperr) (princ) ) (defun trap1 (errmsg) (command "._PSPACE") (SETVAR "OSMODE" osnp) (princ) )

Nikon, you forgot to add open and closing brackets for v1 and v2... Like I said it should be : (atof v1) and (atof v2)...

Whereever in the code occurs v1 or v2, change them to (atof v1) and (atof v2)...

Very true. Glad to see you posting more Lee.

Presumably you're assuming an MLEADER as opposed to a LEADER? For a LEADER entity, an arrowhead size override is set within the extended entity data, e.g.: (defun c:myleader ( / p q s ) (if (and (setq p (getpoint "\n1st point: ")) (setq q (getpoint "\n2nd point: " p)) (setq s (getdist "\nSpecify arrowhead size: ")) ) (progn (regapp "ACAD") (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader") (cons 10 (trans p 1 0)) (cons 10 (trans q 1 0)) (list -3 (list "ACAD" '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 41) (cons 1040 s) '(1002 . "}") ) ) ) ) ) ) (princ) )

You could try this too: (defun c:foo (/ a d) (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a)))) ) (vlax-for b (vla-get-blocks d) (if (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vlax-for o b (vl-catch-all-apply 'vla-put-layer (list o "0")) (vl-catch-all-apply 'vla-put-color (list o 256)) ) ) ) (foreach l a (vlax-put l 'lock -1)) (vla-purgeall d) (vla-regen d acactiveviewport) (princ) )

As we say here in NL : garantie tot aan de deur I've updated RlxPaste in attempt to handle dynamic blocks a little different than the normal cut/copy stuff. At this time it only works (if it works at all) when you select 1 dynamic block to add. It checks if block is dynamic or not. If so , it reads all dymanic properties of this block (I nicked a couple of Grand Master Lee's routines but don't tell him ) Save the block (under a different name of course because you can't save a block with the same name as the dwg) Then it writes all properties to a text file in the same folder & same name as the block but with extenion dbd (dynamic block data). Theory is that after insert it reads this dbd file and puts all props back. If it works , oh happy day , if it doesn't this conversation never happend... RlxPaste.LSP

I never wrote this app with dynamic blocks in the back in my mind but I may have a look at this someday. Thing is , I have very few dynamic blocks myself. Probably can count them on one hand. Mainly because static block are easier to handle in lisp. (very difficult to teach old dragons new tricks haha)

If the inner text touches any segment of the lwpolyline, '(ssget "WP"...)' would not include the text in the selection set. Also, performing recursive 'ssget's could be too slow on large drawings.

Hi @p7q, You can use system variable nomutt. The default value is 0, you need to change it to 1. You can see from one of part from code (it will supress the default "Select objects:" from ssget): ........ (setq old_nomutt (getvar 'nomutt)) (setvar 'nomutt 1) (princ "Select all Text entities:") (setq ss (ssget '((0 . "*TEXT"))) ........ (setvar 'nomutt old_nomutt) (princ)

here's something to list all block names that live in a group ;;; blocks in group (defun c:big ( / gl ) (vl-load-com) (if (not (vl-consp (setq gl (lag)))) (alert "Computer says no : there are no groups") ;;; show all blocks in group (choose from group list) (sabig (cfl gl)) ) (princ) ) ;;; list all groups (setq rtn (lag)) (defun lag ( / gps lst) (setq gps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for g gps (setq lst (cons (vla-get-name g) lst))) (if (vl-consp lst) (acad_strlsort lst)) ) ; 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))) ;;; 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)))) ; multiple association (defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l)) ;;; test if (vla) object is a block / get blockname / ename->vla-object (defun block-p (o) (and (setq o (e->o o)) (member (vla-get-objectname o) '("AcDbBlockReference" "AcDbBlockTableRecord")))) (defun block-n (o) (if (block-p o)(if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)))) (defun e->o (e) (cond ((= 'vla-object (type e)) e)((= 'ename (type e))(vlax-ename->vla-object e))(t nil))) ;;; show all blocks in group (defun sabig (gname / odic gdic grec el blist) (setq odic (namedobjdict)) (setq gdic (dictsearch odic "ACAD_GROUP")) (setq grec (dictsearch (cdar gdic) gname)) (setq el (massoc 340 grec)) (if (vl-consp el) (foreach x el (if (block-p x)(setq blist (cons (block-n (e->o x)) blist))))) (if (vl-consp blist) (dplm (acad_strlsort blist) (strcat "Blocks in group " gname)) (alert (strcat "Computer says no : sorry no block in group " gname)) ) )

Just a comment provided the layer exists, you can use a (cons 8 "Linework") in the entmake to make object on a certain layer.

This is not correct. Entities within the database are being modified, but the database is not being 'rearranged'. The reason that the loop does not terminate is because the equality & inequality operators work with strings & numerical data types, whereas the variables en & enlast are entity names (essentially pointers). As such, when comparing the pointers, the operators are not comparing the data to which they point, but the pointers themselves - this can be confirmed with the following simple test: _$ (setq e2 (entlast)) <Entity name: 2e2aabd68a0> _$ (setq e1 (car (entsel))) <Entity name: 2e2aabd68a0> Observe that variables e1 & e2 point to the same entity data, but have been created separately. When using the equality or inequality operators, the memory addresses of the pointers themselves are being compared, which are not equal: _$ (= e1 e2) nil _$ (/= e1 e2) T If we copy the pointer, the address will now be equal: _$ (setq e3 e1) <Entity name: 2e2aabd68a0> _$ (= e1 e3) T Instead, we should use the eq function to compare the data to which the pointers point: _$ (= e1 e2) nil _$ (eq e1 e2) T As such, the code could potentially be written: (defun c:tf ( / ed1 ed2 en enlast ) (setq enlast (entlast) en (entnext) ) (while (not (eq en enlast)) (setq ed1 (entget en) ed2 nil ) (if (= "LWPOLYLINE" (cdr (assoc 0 ed1))) (progn (foreach x ed1 (if (= 10 (car x)) (setq ed2 (append ed2 (list (list 10 (+ 100 (cadr x)) (+ 100 (caddr x)))))) (setq ed2 (append ed2 (list x))) ) ) (entmod ed2) ) ) (setq en (entnext en)) ) (princ) ) However, note that this will not operate on the last entity added to the database, and so to include it, we could write the code as: (defun c:tf ( / ed1 ed2 en ) (setq en (entnext)) (while en (setq ed1 (entget en) ed2 nil ) (if (= "LWPOLYLINE" (cdr (assoc 0 ed1))) (progn (foreach x ed1 (if (= 10 (car x)) (setq ed2 (append ed2 (list (list 10 (+ 100 (cadr x)) (+ 100 (caddr x)))))) (setq ed2 (append ed2 (list x))) ) ) (entmod ed2) ) ) (setq en (entnext en)) ) (princ) )

just a simplified example with GRREAD (only works for TEXT with integers and currently no undo built in) (defun RlxSel1 ( $e-type / done-selecting inp i p2 result e ent) (princ (strcat "\nEsc, enter, Rmouse to cancel, zoom with E(extend), Z(oom) or + / -\nSelect " $e-type)) (setq done-selecting nil) (while (not done-selecting) (setq inp (vl-catch-all-apply 'grread (list nil 4 2))) (if (vl-catch-all-error-p inp) (setq done-selecting t result nil) (cond ; if point selected ((= (car inp) 3) ; if point has object under it (if (setq ent (nentselp (cadr inp))) (setq e (car ent) typ (get_type e))) (cond ; if we have object and object is the right type we have a winner ((and e typ (eq $e-type typ)) (redraw e 3)(setq done-selecting t result e)) ; maybe its the parent ; this happens when type is dimension and you select dimensions text ((and (caddr ent) (setq ent (last (last ent)))(eq $e-type (get_type ent))) (redraw ent 3)(setq done-selecting t result ent)) ; sorry object is not the right stuf ((and e typ (not (eq $e-type typ))) (princ (strcat "\rYou selected the wrong type (" $e-type ")"))) ; else try crossing selection (t (if (and (setq i 0 p2 (getcorner (cadr inp) "\tOther corner : ")) (setq ss (ssget "c" (cadr inp) p2))) (while (setq e (ssname ss i)) (if (= (cdr (assoc 0 (entget e))) $e-type) (progn (redraw e 3) (setq result e done-selecting t))) (setq i (1+ i)))) );end t ); end cond ); end (= (car inp) 3) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (setq done-selecting t result nil)) ; user pressed + ((equal inp '(2 43)) (command "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (command "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (command "'zoom" "")) ;;; enter undo routine here ;;; *********************** ) ) ) result ) ; 'kelvinated' (compressed) version of vt_splituptext ; (splitss (getvar 'dwgname)) -> ("06" "E" "001474" "S" "0011" ".DWG") ; (vl-remove-if-not 'distof (splitss "06E001474S0011.dwg")) -> ("06" "001474" "0011") ;;; (setq r (Splitss (cdr (assoc 1 (entget (car (entsel))))))) (defun splitss (s / a c p l d i) (if (and s (= (type s) 'str)(> (strlen s) 0)(setq i 1)(setq d ""))(progn (if (wcmatch (substr s i 1) "#")(setq p "num")(setq p "s")) (while (<= i (strlen s))(if (wcmatch (substr s i 1) "#")(setq c "num")(setq c "s"))(if (= c p)(setq d (strcat d (substr s i 1))) (progn (setq l (append l (list d)) p c d (substr s i 1))))(setq i (1+ i)))(if (and d (/= d ""))(setq l (append l (list d)))))) l) (defun isnum (n)(if (distof n) t nil)) (defun get_type ( %o ) (cond ((= (type %o) 'ENAME)(cdr (assoc 0 (entget %o)))) ((= (type %o) 'VLA-object)(cdr (assoc 0 (entget (vlax-vla-object->ename %o))))) (t nil) ) ) ;;; test 1 : increment with 1 (defun c:t1 ( / inc sel) (setq inc 1) (while (setq sel (RlxSel1 "TEXT")) (inc_ent sel)) (princ) ) (defun inc_ent (e / ent ent-type str-lst new-str-lst new-str done s len) (cond ((null e) (alert "Computer says no : nothing selected")) ((not (eq (type e) 'ename)) (alert (strcat "Computer says no : wrong type (" (vl-princ-to-string (type e)) ")"))) ((not (eq (setq ent-type (cdr (assoc 0 (setq ent (entget e))))) "TEXT")) (alert (strcat "Computer says no : selected object is not a text (" (vl-princ-to-string ent-type) ")"))) (t ;;; assuming last number must be incremented I reverse the string list and work from end to begin (setq done nil new-str-lst '() str-lst (reverse (Splitss (cdr (assoc 1 ent))))) (while (and (vl-consp str-lst) (not done) (setq s (car str-lst))) (setq str-lst (cdr str-lst)) (if (isnum s) (progn ;;; make sure "001" becomes "002" and not "2" (setq len (strlen s)) ;;; increment string with inc (setq s (itoa (+ inc (atoi s)))) ;;; put back leading zero's (while (< (strlen s) len) (setq s (strcat "0" s))) ;;; save to new string list (setq new-str-lst (cons s new-str-lst) done T) ) (setq new-str-lst (cons s new-str-lst)) );;; end if );;; end while (while (vl-consp str-lst) (setq new-str-lst (cons (car str-lst) new-str-lst) str-lst (cdr str-lst))) ;;; put string back together (if (vl-consp new-str-lst) (setq new-str (apply 'strcat new-str-lst))) ;;; update text object (setq ent (subst (cons 1 new-str) (assoc 1 ent) ent)) ;;; update ent (entmod ent)(entupd e) ) ) ) for undo to work built an undo (assoc) list with ent + original text string and when undoing get last ent in list , reset text and remove it from undo-list. Should look something like this : (setq undo-list (reverse (cdr (reverse undo-list)))) Unless you built this list with cons , then (setq undo-list (cdr undo-list)) will work too. I do have a far more advanced program (VT.lsp) for my increment jobs , posted it years ago , which I still use to this day. Added lots of options through the years but most of them are so company specific I don't think its useful to post the latest version (also it still doesn't like Mtext) because I have no use for Mtext for my line of work so every time I see one I blow it out of the water.

Yes, there isn't a perfect solution that I have found: (setq in the code will hint at the variable used but if the code is (setq a .... b ... c ...) it will only pick up a, not b, c atoms-family... unless the variable has been used previously, a global variable perhaps... which I think is the OPs intention to localise variables, though a new drawing where you only run the LISP in question should get most (except in auto-run LISPs). However in that any branches in the code - if statements - will only record the variables used in the particular branch selected, you'd need to run the code a few times to capture each possibility. Could try something like notepad++ where variables are highlighted, though that takes some discipline to record which variables are used.... good habits arn't bad thing

It is difficult to get variables declared in a lisp by just reading the file. Because it often happens that a variable is declared without having 'setq' in front of it. I think the safest way is to call 'atoms-family', execute the code in your file and then call 'atoms-family' again. The difference between the list returned by the first call and the second is the list you need.

A better place to save a value is using LDATA as some one else's code may reset the "Userxx", you can also do a UNDO mark so can go back many undo's in one step. (setq num (vlax-ldata-get "numinc" "num" )) (vlax-ldata-put "numinc" "num" x)

Good improvement! And one more thing... dmp.lsp

So that no one says that I throw stones and hide my hand, here is my proposal for improvement. (defun c:myDimAlign (/ x e p s d o pS os xD asr dt pr ar osmant) ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M ;; ;;; ;; GGGG LL A VV VV CCCC VV VV SSSS ;;; ;; GG GG LL AA AA VV VV CC CC VV VV SS SS ;;; ;; GG LL AA AA VV VV CC VV VV SS ;;; ;; GG GGGG LL AA AA VV VV CC VV VV SSSS ;;; ;; GG GG LL AA AAA AA VV VV CC VV VV SS ;;; ;; GG GG LL LL AA AA V V CC CC V V SS SS ;;; ;; GGG LLLLLLLL AA AA VV CCCC VV SSSS ;;; ;; ;;; ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M (defun os (/ d p i) (while (and (setq f (cdr (assoc 10 (setq x (cdr (member (setq p (assoc 10 x)) x)))))) (/= (max (distance (cdr p) pS) (distance f pS) (setq d (distance (setq i (cdr p)) f))) d) ) ) i ) (defun xD (c1 c2 / ed pt r of) (if (not dt) (setq dt (distance o (cadr s)) ar (asr (os) pS o)) ) (polar c2 (ar (angle c1 c2) (/ pi 2)) dt) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (setq osmant (getvar 'OSMODE)) (setvar 'OSMODE 0) (if (and (setq e (car (setq s (entsel "\nSelect any LWpolyline...")))) (= (cdr (assoc 0 (setq x (entget e)))) "LWPOLYLINE") (setq o (getpoint (setq pS (cadr s)) "\nSide to act on...")) ) (foreach g (if (= (rem (cdr (assoc 70 x)) 2) 0) x (setq x (append x (list (assoc 10 x))))) (if (= (car g) 10) (if p (command "_DIMALIGNED" p (cdr g) (xD p (setq p (cdr g)))) (setq p (cdr g)) ) ) ) ) (if osmant (setvar 'OSMODE osmant)) (princ) )

(defun normalize (vec / len) (if (> (setq len (distance '(0 0) vec)) 1e-9) (list (/ (car vec) len) (/ (cadr vec) len)) vec ) )

It Works! Yay! Thank you very much! But it takes looooong time to process all data - , and ends up with just the spinning wheel so I can't even save when it's finished. I even left it over night, but that didn't help - some kind of overflow? I guess I have to divide the data up in smaller parts and run them one by one... But it works, and that's what matters.

As already mentioned, when you pick a blank spot on the dwg you will get nil returned, so can then pop a choice exit or change step. I use my Multi radio buttons as below its here in Downloads, you can use Acet-yes--no where yes would mean set Step, no is Exit, You can use initget "Exit Step". Yes I do use this method when asking to add to a table or start a new one. Ps (exit) will do just that a built in lisp function.

The problem, I think, is that 'entsel' is not suitable for what you need. Because the value that 'entsel' can deposit in 'targetObject' can only be a list '(entity_name point)' or 'nil'. That is: it can never be "", nor "Step" nor "Exit"

Lots 7 & 8 are the same size... 60 x120. The 120 ft dimension is perpendicular to the north street line of SW Village Lane while the 60 ft dimension is parallel to the north street line of SW Village Lane. To create the easterly property line of lot 7 offset the westerly street line of SW Oleson Road a distance of 50 ft. Offset that line 60 ft to the west. Then offset that line another 60 ft. to the west. Offset the northerly street line of SW Village Lane 120 ft. and trim everything up as required.

It won't get all of them, only the ones preceded with (setq but it is a start

My humble opinion is that your ENTSEL function stands in the way between your dreams and success. It only accepts a selection. If you were to use GRREAD it would be possible to both detect if you clicked on something or pressed a key like 'u' for undo or 'tab' to switch between increment or decrement. Using the 'tab' key you could for example change the increment number from +1 to -1 , or with plus and minus keys you could increment , well , the increment. Not sure if I have something 'on the shelf' but I'm pretty sure searching this site could give you some results too.

It's interesting Maybe the solution is to mix the 2 approaches: call 'atoms-family' at the beginning and start a loop in which the code tries to identify each expression in the file, evaluates it (creating the arguments that are necessary) and calls 'atoms-family' to check if any new symbol has been created. And, in this way, repeat the loop as many times as expressions the code detects. It's a good task

Of course: 'activeDocument' should be ... (vlax-get-activedocument (vlax-get-modelSpace (vlax-get-acad-object))) (I hope I haven't written anything wrong from my smartphone)

If you use several Lisp and you don't know exactly what they do, then the best option is BIGAL: LDATA. But you will have to assign them to an object that is safe from any contingency: 'activeDocument' To assign it: (vlax-ldata-put activeDocument 'valueIncrement value)

Should be this one: (defun GetMyFolder( / MILFO) (defun GetDesktop ( / script spFolders desktop) (cond ( (setq script (vlax-create-object "WScript.Shell")) (setq spFolders (vlax-get-property script "SpecialFolders") desktop (vlax-invoke-method spFolders 'Item "Desktop") ) (vlax-release-object spFolders) (vlax-release-object script) ) ) desktop ) ;; (setq MILFO (strcat (getdesktop) "\\AutoCAD\\AutoCAD LISPS\\")) ;; your LISP file path, though it doesn't matter too much. Use this line to go from Desktop (setq MILFO "c:\\") MILFO )

Although it is possible that there are parts of the code that are not executed and those variables are not declared. Therefore, I recognize that it is not the perfect solution either.

This isn't 100% bug free: srchlsp About 350 lines, can probably be done a bit better ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:ListVariables ( / MyFile) ; ready for batch (setq MyFile (getfiled "Select LISP File to Query" (getmyfolder) "lsp" 16)) (srchlsp MyFile ) (princ) ) (defun c:srchlsp ( / MyFile) ; ready for batch (setq MyFile (getfiled "Select LISP File to Query" (getmyfolder) "lsp" 16)) (srchlsp MyFile ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun lstprts ( MyList StartDel EndDel startpos / result acount acounter NewLst pos) ;; Make list from lines (setq NewLst (list)) (setq acounter 0) (setq acount startpos) (while (< acount (length MyList)) (if (= (nth acount MyList) StartDel) (setq acounter (+ acounter 1)) ) (if (= (nth acount MyList) EndDel) (setq acounter (+ acounter -1)) ) (setq acount (+ acount 1)) (if (= acounter 0) (progn (setq pos acount) (setq acount (length MyList)) ) (progn (setq NewLst (append NewLst (list (nth acount MyList)))) ) ) ) ; end while (setq result (list pos (append (list StartDel) NewLst))) result ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun splitlst ( MyList StartDel EndDel / result acount lst aresult x y z) ;; split into main functions (setq result (list)) (setq acount 0) (while (< acount (length MyList)) ; split up main functions (setq lst (lstprts MyList StartDel EndDel acount)) (setq result (append result (list (nth 1 lst)))) (setq acount (nth 0 lst)) ) ; end while (setq MyList (list)) (foreach x result (setq aresult (splitsublist x StartDel EndDel)) (foreach y aresult (setq z (vl-string-left-trim "0123456789 " y)) (setq MyList (append MyList (list z))) ) ) ; end foreach MyList ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun splitsublist ( MyList StartDel EndDel / StartCounter SplitList SplitListLength defcounterlist maxdefcount totaldefuns defuncount acount) ; split sub functions (setq StartCounter 0) (setq SplitList (list)) (setq SplitListLength 0) (setq defcounterlist (list 0)) (setq maxdefcount 0) (setq totaldefuns (- (length MyList) (length (vl-remove StartDel MyList)))) (if ( = totaldefuns 1) (progn (setq MyList (LM:Unique MyList)) ; unique values only (setq SplitList (list (strcat "0 " (LM:lst->str MyList " ") ))) ) (progn (setq defuncount -1) (setq acount 0) (while (< acount totaldefuns) ; create blank list, SplitList (setq SplitList (append SplitList (list (rtos acount) ))) (setq acount (+ acount 1)) ) (foreach x MyList (if (= x StartDel) (progn (setq maxdefcount (+ maxdefcount 1)) (setq defcounterlist (append defcounterlist (list maxdefcount))) ) ; end progn ) ; go up 1 (setq defuncount (- (last defcounterlist) 1) ) (setq SplitList (subst (strcat (nth defuncount SplitList) " " x) (nth defuncount SplitList) SplitList)) (if (= x EndDel)(setq defcounterlist (reverse (cdr (reverse defcounterlist)))) ) ; go down 1 defuncounter ) ; end foreach (setq asplitlist (list)) (foreach x SplitList (setq SplitList (subst (LM:lst->str (LM:Unique (LM:str->lst x " ")) " ") x SplitList)) ; unique values ) ) ; end prgn ) ; end if SplitList ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun LM:lst->str ( lst del / ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) (defun LM:Unique ( l / ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) (defun LM:StringSubst ( new old str / inc len ) (setq len (strlen new) inc 0 ) (while (setq inc (vl-string-search old str inc)) (setq str (vl-string-subst new old str inc) inc (+ inc len) ) ) str ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun removequotes ( line / splittext acount) (setq splittext (LM:str->lst line (chr 34))) ; ignore " (setq acount 0) (setq line "") (while ( < acount (length splittext)) (setq line (strcat line (nth acount splittext))) (setq acount (+ acount 2)) (if (= acount (length splittext))(setq line (strcat line (last splittext)))) ; a bad fix ) ; end while line ) ; end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun countbracketO ( line / splittext) (setq line (removequotes line)) (setq splittext (LM:str->lst line (chr 40))) (- (length splittext) 1) ) ; end defun (defun countbracketC ( line / splittext) (setq line (removequotes line)) (setq splittext (LM:str->lst line (chr 41))) (- (length splittext) 1) ) ; end defun ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun MakeClipBoardText ( MyText / htmlfile ) (vlax-invoke (vlax-get (vlax-get (setq htmlfile (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Mytext) (vlax-release-object htmlfile) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun WriteListToFile ( AList / fn Lispfile LFDES x MyString) (setq fn "srchlsp.txt") (if (strcat (getvar "TEMPPREFIX") fn)(vl-file-delete (strcat (getvar "TEMPPREFIX") fn))) (setq Lispfile (strcat (getvar "TEMPPREFIX") fn)) (setq LFDES (open Lispfile "w")) (foreach x AList (setq MyString (vl-string-trim "EndDefun" x)) (write-line MyString LFDES) ) (setq LFDES (close LFDES)) (if (findfile Lispfile) (startapp "notepad" Lispfile)) (if (not (findfile Lispfile)) (princ "\nError writing file")) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;returns the next word(s) in a text string after the search term(s) (defun NextWord ( s p / l result lcount pcount MyString x y) (defun xyz123 ( p l lcount / MyString pcount x ) (setq MyString nil) (setq pcount 0) (while (< pcount (length p)) (if (setq x (vl-string-search (strcase (nth pcount p)) (strcase (nth lcount l)))) ; if in text strng, (progn (setq MyString (strcat (nth pcount p) " " (nth (+ lcount 1) l))) (setq pcount (+ pcount 1)) ) (progn (setq pcount (+ pcount 1)) ) ; end progn ) ; end if ) ; end while MyString ) ; end defun (setq l (LM:str->lst s " ") ) ; make line into list (setq result (list)) (setq y 0) (setq pcount 0) (while (< pcount (length p) ) ; check line for search terms (setq x (vl-string-search (strcase (nth pcount p)) (strcase s))) (if (= x nil)()(setq y (+ y 1))) (setq pcount (+ pcount 1)) ) ; end while (if (> y 0) ; do for applicable lines (progn (setq lcount 0) (while (< (+ lcount 1) (length l)) (setq MyString (xyz123 p l lcount)) (if (= MyString nil) () (setq result (append result (LM:str->lst MyString " ") )) ) (setq lcount (+ lcount 1)) ) ; end while ) ; end if ) ; end progn result ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun srchlsp ( file / *error* searchlist EndDelim Nesteddefuns TxtLst f CTO CTC CT Line FoundText MyCount TempList LstTxt x) (defun *error* ( msg / MyError ) (setq MyError 1) (if (and file (eq 'FILE (type file))) (close file)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun stringsub ( MyString newterm oldterm / ) (setq strsrch (vl-string-search oldterm MyString)) (while (/= strsrch nil) (setq MyString (vl-string-subst newterm oldterm MyString) ) (setq strsrch (vl-string-search oldterm MyString)) ) MyString ) (setq alerttext "This will produce a temporary text file showing:") (setq alerttext (strcat alerttext "\nFunction names variables used in that function.")) (setq alerttext (strcat alerttext "\n\nResults Explained")) (setq alerttext (strcat alerttext "\n'(' Blank line indicates a 1 line function (unnamed in this listing)")) (setq alerttext (strcat alerttext "\nVariables will only be found if coded \"(strcat xyz....\"")) (setq alerttext (strcat alerttext "\nThe whole lot failes if brackets are out of order or other similar things")) (alert alerttext) (setq searchlist (list (strcat "(defun")(strcat "(setq")(strcat "(foreach") )) (setq enddelim "EndDefun") (setq nesteddefuns (list)) (setq TxtLst (list) ) (setq ctO 0)(setq ctC 0)(setq ct 0) ;; reset bracket counters (setq linelist (list)) (princ "Searching for: ")(princ searchlist)(princ "\n") (setq LineCount 0) (if (setq f (open file "r")) (progn (while (setq line (read-line f)) (setq line (stringsub line "" (strcat (chr 92)(chr 92)))) ; remove \\ (setq line (stringsub line "" (strcat (chr 92)(chr 34)))) ; remove \" (setq line (removequotes line)) ;; remove quotes '"' (setq line (nth 0 (LM:str->lst line ";"))) ;; Remove Comments ';' (if (or (= line nil) (= line "") ) ;; ignore commented out lines, blank lines () (progn (setq ctO (countbracketO line)) ;; count opening brackets (setq ctC (countbracketC line)) ;; count closing brackets (setq ct (+ ct (- ctO ctC))) ;; sum brackets (if (= (wcmatch (strcase line) (strcase (strcat "*" (nth 0 searchlist) "*"))) nil) ;;assuming only 1 defun per line () (if (= ctO ctC) (setq nesteddefuns (append (list ct) nesteddefuns)) ; single line function (if (= ctC 0) (progn (while (/= ctO (+ ctC 1)) (setq lineb (read-line f)) (setq lineb (LM:StringSubst "" (strcat (chr 92)(chr 34)) lineb)) (setq lineb (removequotes lineb)) ;; remove quotes '"' (setq lineb (nth 0 (LM:str->lst lineb ";"))) ;; Remove Comments ';' (if (or (= lineb nil) (= lineb "") ) ;; ignore commented out lines, blank lines () (progn (setq line (strcat line lineb)) (setq ctO (countbracketO line)) ;; count opening brackets (setq ctC (countbracketC line)) ;; count closing brackets (setq ct (+ ct (- ctO ctC))) ;; sum brackets ) ; end progn ) ; end if ) ; end while (setq nesteddefuns (append (list (- ct 1)) nesteddefuns)) ; multiline function ) ; end progn (progn (setq nesteddefuns (append (list (- ct 1)) nesteddefuns)) ; multiline function ) ; end progn ) ; end if ) ; end if ) ; end if (if (= ct (car nesteddefuns)) ;; if ct value is the same as the list (progn (setq linelist (append linelist (list enddelim))) (setq nesteddefuns (cdr nesteddefuns)) ) ; end progn ) ; end if ;;;add in search expressions (if (and (foreach x seachlist (= (wcmatch (strcase line) (strcase (strcat "*" x "*"))) nil) ) ) () (setq linelist (append linelist (NextWord line searchlist))) ) ; end if ) ; end progn ) ; end if 'non blank lines' ) ; end while (close f) ) ; end progn ) ; end if (setq lsttxt (splitlst linelist (nth 0 searchlist) enddelim)) ;Display in command line (foreach x lsttxt (princ "\n") (princ (type x)) (princ x) ) (WriteListToFile lsttxt) ;; (MakeClipBoardText (LM:lst->str lsttxt " ")) (princ) )

Yes, there are plenty of examples out there to write to a notepad file, use the write-line code and the value. Can't remember just now if the value has to be a string (RTOS) but you can find that out easy enough, and of course you can use something like (strcat ) to concatenate strings and variables together into a single line. A common example of this might be creating a DCL 'on the fly' where it creates a temporary text file and that can be used. Once you have created the text file you will want to open it using something like (startapp "c:/windows/notepad.exe" 'filename')

A couple of ideas use a (ssget "F" where you drag a line through all the red cut lines this should return them in correct order, pick pline, do offset, and then as suggested can do the pairs break. I would also check is the number of cut lines even if not then dont run. You need to do the break twice inner and outer pline so 4 points can then cap as well. Will have a think about it. Just a ps (setq intpt1 (vlax-invoke obj2 'intersectWith obj acextendnone)) returns (58.111571345732 222.717516115398 0.0) No need for the safe array

But there is another, simpler way to get the intersection, which makes the part of your code that gets the lists of points unnecessary: 'vla-intersectWith' Simply replace the line of code that starts with '(setq kl (inters ...))' with... (setq kl (safearray-value (variant-value (vla-intersectWith (vlax-ename->vla-object poly) (vlax-ename->vla-object line) 0))))

Your code should advance through the list of points on the polyline until it finds the segment that intersects the line.

The answer is simple: the first segment of the polyline does not intersect the line. If, at first glance, you can see that the line intersects the polyline, it means that it does so in another segment, but not in the first one.

Try like this. @226.4<S50d43'14"E Note the "d" or "D"

One option would be to create a lisp routine like this... setvar "plinewid" 0.0125 (sets plinewid to 1/8") then put that whole line in your acaddoc.lsp file so it will be loaded each time a drawing is opened.

common design in Revit