Guest Posted October 16, 2022 Posted October 16, 2022 (edited) Hi I want to select and close all the polylines in a group of layers and remove the overlap vertex at the end. And if it possible report how many polylines selected in eatch layer (defun c:test ( /) (setq sel (ssget "_X" (list '(0 . "*POLYLINE") '(8 . "Layer1,Layer2,Layer3")))) (command "_.PEDIT" "_M" sel "" "_Close" "") (princ) (write-line "=========================================================" F) (write-line " Results " F) (write-line "=========================================================" F) (write-line "" F) (write-line "(selected polylines) polylines from (Layer 1) " F) (write-line "(selected polylines) polylines from (Layer 2) " F) (write-line "(selected polylines) polylines from (Layer 3) " F) (write-line "" F) (close F) (startapp "NOTEPAD" txt) ) end defun Thanks Edited October 16, 2022 by prodromosm Quote
mhupp Posted October 16, 2022 Posted October 16, 2022 (edited) When you say (selected polylines) you want a count? I'll have to think on duplicate vertices. (defun c:test (/ L1 L2 L3 SS poly F txt) (setq L1 0 L2 0 L3 0) (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "Layer1,Layer2,Layer3")))) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "Layer1") (setq L1 (1+ L1)) ) ((eq lay "Layer2") (setq L2 (1+ L2)) ) ((eq lay "Layer3") (setq L3 (1+ L3)) ) ) ) (setvar 'cmdecho 0) (command "_.PEDIT" "_M" SS "" "_C" "") (setvar 'cmdecho 1) (setq F (open (setq txt (strcat (getvar 'TEMPPREFIX) "TEXTFILE.TXT")) "w")) (write-line "=========================================================" F) (write-line " Results " F) (write-line "=========================================================" F) (if (>= L1 1) (write-line (strcat "Closed " (rtos L1 2 0) " Polylines on (Layer 1)" F)) (write-line (strcat "No Open Polylines on (Layer 1)" F)) ) (if (>= L2 1) (write-line (strcat "Closed " (rtos L2 2 0) " Polylines on (Layer 2)" F)) (write-line (strcat "No Open Polylines on (Layer 2)" F)) ) (if (>= L3 1) (write-line (strcat "Closed " (rtos L3 2 0) " Polylines on (Layer 3)" F)) (write-line (strcat "No Open Polylines on (Layer 3)" F)) ) (write-line "" F) (close F) ;RELEASES FILE FROM AUTOCAD OR YOU CANT MOVE/DELETE/SAVE THE FILE UNTIL AUTOCAD IS CLOSED (startapp "NOTEPAD" txt) ) Edited October 17, 2022 by mhupp put a ) in the wrong place Quote
Guest Posted October 16, 2022 Posted October 16, 2022 Hi mhupp. I have an error !!! And i don't know why? Command: TEST _.PEDIT Select polyline or [Multiple]: _M Select objects: 4 found Select objects: Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]: _C Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]: Command: ; error: bad argument type: stringp #<file "C:\\Users\\Prodromos\\appdata\\local\\temp\\TEXTFILE.TXT"> (defun c:test (/ L1 L2 L3 SS poly F txt) (setq L1 0 L2 0 L3 0) (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "Layer1,Layer2,Layer3")))) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "Layer1") (setq L1 (1+ L1)) ) ((eq lay "Layer1") (setq L2 (1+ L2)) ) ((eq lay "Layer1") (setq L3 (1+ L3)) ) ) ) (command "_.PEDIT" "_M" SS "" "_C" "") (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w")) (write-line "=========================================================" F) (write-line " Results " F) (write-line "=========================================================" F) (if (>= L1 1) (write-line (strcat "Closed " (rtos L1 2 0) " Polylines on (Layer 1)" F)) (write-line (strcat "No Open Polylines on (Layer 1)" F)) ) (if (>= L2 1) (write-line (strcat "Closed " (rtos L2 2 0) " Polylines on (Layer 2)" F)) (write-line (strcat "No Open Polylines on (Layer 2)" F)) ) (if (>= L3 1) (write-line (strcat "Closed " (rtos L3 2 0) " Polylines on (Layer 3)" F)) (write-line (strcat "No Open Polylines on (Layer 3)" F)) ) (write-line "" F) (close F) ;RELEASES FILE FROM AUTOCAD OR YOU CANT MOVE/DELETE/SAVE THE FILE UNTIL AUTOCAD IS CLOSED (startapp "NOTEPAD" txt) (princ) );end defun Quote
mhupp Posted October 16, 2022 Posted October 16, 2022 (edited) Saying up too late. I misplaced at ) will work now. --edit You fixed it already. Do you have two instances of autocad open? one has read/write permisson for TEXTFILE.TXT and the other your tying to use the code? if not restart autocad because this might be where StevenP was saying if you exit the lisp before close it would error. if you ran it with the misplaced ) Edited October 16, 2022 by mhupp 1 Quote
Guest Posted October 16, 2022 Posted October 16, 2022 I have the same error error: bad argument type: stringp #<file "C:\\Users\\Prodromos\\appdata\\local\\temp\\TEXTFILE.TXT"> Quote
Guest Posted October 17, 2022 Posted October 17, 2022 (edited) Hi mhupp. In this part of the code you are writing only "Layer1". What hapend the other layer? I have to duplicate it for the other Layers? I have to check 27 layers !!!! (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "Layer1") (setq L1 (1+ L1)) ) ((eq lay "Layer1") (setq L2 (1+ L2)) ) ((eq lay "Layer1") (setq L3 (1+ L3)) ) ) Thanks Edited October 17, 2022 by prodromosm Quote
mhupp Posted October 17, 2022 Posted October 17, 2022 It start working again? Yeah just copy and pasted and didn't go back an change (sorry about that) Should be Layer1 - Layer27 didn't know the names ;replace the first line with this setting all the 1-27 counters to 0 (mapcar '(lambda (x) (set x 0)) '(L1 L2 L3 L4 ... L25 L26 L27)) (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "Layer1") ;this line generates the layer and stores it as lay & also checks it. (setq L1 (1+ L1)) ) ((eq lay "Layer2") ;and will check it against the rest of the layers you put in the cond (setq L2 (1+ L2)) ) ((eq lay "Layer3") (setq L3 (1+ L3)) ;if it matches will add 1 to the number 0+1 = 1 ) ;next entity thats on this layer 1+1=2 and so on. ... ((eq lay "Layer27") (setq L27 (1+ L27)) ) ) then you need 27 if statements checking the counts. (if (>= L1 1) (write-line (strcat "Closed " (rtos L1 2 0) " Polylines on (Layer 1)" F)) (write-line (strcat "No Open Polylines on (Layer 1)" F)) ) ... (if (>= L27 1) (write-line (strcat "Closed " (rtos L27 2 0) " Polylines on (Layer 27)" F)) (write-line (strcat "No Open Polylines on (Layer 27)" F)) ) Should spit out something like ========================================================= Results ========================================================= Closed 5 Polylines on (Layer 1) Closed 3 Polylines on (Layer 2) No Open Polylines on (layer 3) ... Closed 2 Polylines on (Layer 27) Quote
Guest Posted October 17, 2022 Posted October 17, 2022 Hi mhupp. I write the code for 12 layers to check the code. I have an error in export file. I can not understand why. Close and open autocad again but noting. Can you test the code ? (defun c:test2 (/ L1 L2 L3 SS poly F txt) (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w")) (setq L1 0 L2 0 L3 0 L4 0 L5 0 L6 0 L7 0 L8 0 L9 0 L10 0 L11 0 L12 0) (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "PST_KAEK,TOPO_PROP,BLD,VST,EAS,MINE,VST_FINAL,EAS_FINAL,MINE_FINAL,DGM_PROP_FINAL,AREA_D,AREA_A")))) (mapcar '(lambda (x) (set x 0)) '(L1 L2 L3 L4 L5 L6 L7 L8 L9 L10 L11 L12)) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "PST_KAEK") (setq L1 (1+ L1)) ) ((eq lay "TOPO_PROP") (setq L2 (1+ L2)) ) ((eq lay "BLD") (setq L3 (1+ L3)) ) ((eq lay "VST") (setq L4 (1+ L4)) ) ((eq lay "EAS") (setq L5 (1+ L5)) ) ((eq lay "MINE") (setq L6 (1+ L6)) ) ((eq lay "VST_FINAL") (setq L7 (1+ L7)) ) ((eq lay "EAS_FINAL") (setq L8 (1+ L8)) ) ((eq lay "MINE_FINAL") (setq L9 (1+ L9)) ) ((eq lay "DGM_PROP_FINAL") (setq L10 (1+ L10)) ) ((eq lay "AREA_D") (setq L11 (1+ L11)) ) ((eq lay "AREA_A") (setq L12 (1+ L12)) ) ) ) (command "_.PEDIT" "_M" SS "" "_C" "") (write-line "=========================================================" F) (write-line " Results " F) (write-line "=========================================================" F) (if (>= L1 1) (write-line (strcat "Closed " (rtos L1 2 0) " Polylines on PST_KAEK" F)) (write-line (strcat "No Open Polylines on PST_KAEK" F)) ) (if (>= L2 1) (write-line (strcat "Closed " (rtos L2 2 0) " Polylines on TOPO_PROP" F)) (write-line (strcat "No Open Polylines on TOPO_PROP" F)) ) (if (>= L3 1) (write-line (strcat "Closed " (rtos L3 2 0) " Polylines on BLD" F)) (write-line (strcat "No Open Polylines on BLD" F)) ) (if (>= L4 1) (write-line (strcat "Closed " (rtos L4 2 0) " Polylines on VST" F)) (write-line (strcat "No Open Polylines on VST" F)) ) (if (>= L5 1) (write-line (strcat "Closed " (rtos L5 2 0) " Polylines on EAS" F)) (write-line (strcat "No Open Polylines on EAS" F)) ) (if (>= L6 1) (write-line (strcat "Closed " (rtos L6 2 0) " Polylines on MINE" F)) (write-line (strcat "No Open Polylines on MINE" F)) ) (if (>= L7 1) (write-line (strcat "Closed " (rtos L7 2 0) " Polylines on VST_FINAL" F)) (write-line (strcat "No Open Polylines on VST_FINAL" F)) ) (if (>= L8 1) (write-line (strcat "Closed " (rtos L8 2 0) " Polylines on EAS_FINAL" F)) (write-line (strcat "No Open Polylines on EAS_FINAL" F)) ) (if (>= L9 1) (write-line (strcat "Closed " (rtos L9 2 0) " Polylines on MINE_FINAL" F)) (write-line (strcat "No Open Polylines on MINE_FINAL" F)) ) (if (>= L10 1) (write-line (strcat "Closed " (rtos L10 2 0) " Polylines on DGM_PROP_FINAL" F)) (write-line (strcat "No Open Polylines on DGM_PROP_FINAL" F)) ) (if (>= L11 1) (write-line (strcat "Closed " (rtos L11 2 0) " Polylines on AREA_D" F)) (write-line (strcat "No Open Polylines on AREA_D" F)) ) (if (>= L12 1) (write-line (strcat "Closed " (rtos L12 2 0) " Polylines on AREA_A" F)) (write-line (strcat "No Open Polylines on AREA_A" F)) ) (write-line "" F) (close F) (startapp "NOTEPAD" txt) (princ) );end defun Thanks test.dwg Quote
mhupp Posted October 17, 2022 Posted October 17, 2022 (edited) 36 minutes ago, prodromosm said: I have an error in export file. I can not understand why. Me being a dummy and not checking what I write! (write-line (strcat "Closed " (rtos L12 2 0) " Polylines on AREA_A" F)) ;Wrong - strcat is being fed a string + F (write-line (strcat "Closed " (rtos L12 2 0) " Polylines on AREA_A") F) ;right - strcat string is being fed to F Updated code - ssget needed (70 . 0 ) open polyline (defun c:test2 (/ L1 L2 L3 L4 L5 L6 L7 L8 L9 L10 L11 L12 SS poly F txt) (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w")) (mapcar '(lambda (x) (set x 0)) '(L1 L2 L3 L4 L5 L6 L7 L8 L9 L10 L11 L12)) (if (setq SS (ssget "_X" '((0 . "*POLYLINE") (8 . "PST_KAEK,TOPO_PROP,BLD,VST,EAS,MINE,VST_FINAL,EAS_FINAL,MINE_FINAL,DGM_PROP_FINAL,AREA_D,AREA_A") (70 . 0)))) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "PST_KAEK") (setq L1 (1+ L1)) ) ((eq lay "TOPO_PROP") (setq L2 (1+ L2)) ) ((eq lay "BLD") (setq L3 (1+ L3)) ) ((eq lay "VST") (setq L4 (1+ L4)) ) ((eq lay "EAS") (setq L5 (1+ L5)) ) ((eq lay "MINE") (setq L6 (1+ L6)) ) ((eq lay "VST_FINAL") (setq L7 (1+ L7)) ) ((eq lay "EAS_FINAL") (setq L8 (1+ L8)) ) ((eq lay "MINE_FINAL") (setq L9 (1+ L9)) ) ((eq lay "DGM_PROP_FINAL") (setq L10 (1+ L10)) ) ((eq lay "AREA_D") (setq L11 (1+ L11)) ) ((eq lay "AREA_A") (setq L12 (1+ L12)) ) ) ) ) (command "_.PEDIT" "_M" SS "" "_C" "") (write-line "=========================================================" F) (write-line " Results " F) (write-line "=========================================================" F) (if (>= L1 1) (write-line (strcat "Closed " (rtos L1 2 0) " Polylines on PST_KAEK") F) (write-line (strcat "No Open Polylines on PST_KAEK") F) ) (if (>= L2 1) (write-line (strcat "Closed " (rtos L2 2 0) " Polylines on TOPO_PROP") F) (write-line (strcat "No Open Polylines on TOPO_PROP") F) ) (if (>= L3 1) (write-line (strcat "Closed " (rtos L3 2 0) " Polylines on BLD") F) (write-line (strcat "No Open Polylines on BLD") F) ) (if (>= L4 1) (write-line (strcat "Closed " (rtos L4 2 0) " Polylines on VST") F) (write-line (strcat "No Open Polylines on VST") F) ) (if (>= L5 1) (write-line (strcat "Closed " (rtos L5 2 0) " Polylines on EAS") F) (write-line (strcat "No Open Polylines on EAS") F) ) (if (>= L6 1) (write-line (strcat "Closed " (rtos L6 2 0) " Polylines on MINE") F) (write-line (strcat "No Open Polylines on MINE") F) ) (if (>= L7 1) (write-line (strcat "Closed " (rtos L7 2 0) " Polylines on VST_FINAL") F) (write-line (strcat "No Open Polylines on VST_FINAL") F) ) (if (>= L8 1) (write-line (strcat "Closed " (rtos L8 2 0) " Polylines on EAS_FINAL") F) (write-line (strcat "No Open Polylines on EAS_FINAL") F) ) (if (>= L9 1) (write-line (strcat "Closed " (rtos L9 2 0) " Polylines on MINE_FINAL") F) (write-line (strcat "No Open Polylines on MINE_FINAL") F) ) (if (>= L10 1) (write-line (strcat "Closed " (rtos L10 2 0) " Polylines on DGM_PROP_FINAL") F) (write-line (strcat "No Open Polylines on DGM_PROP_FINAL") F) ) (if (>= L11 1) (write-line (strcat "Closed " (rtos L11 2 0) " Polylines on AREA_D") F) (write-line (strcat "No Open Polylines on AREA_D") F) ) (if (>= L12 1) (write-line (strcat "Closed " (rtos L12 2 0) " Polylines on AREA_A") F) (write-line (strcat "No Open Polylines on AREA_A") F) ) (write-line "" F) (close F) (startapp "NOTEPAD" txt) (princ) ) ;end defun output ========================================================= Results ========================================================= No Open Polylines on PST_KAEK No Open Polylines on TOPO_PROP No Open Polylines on BLD No Open Polylines on VST No Open Polylines on EAS No Open Polylines on MINE No Open Polylines on VST_FINAL No Open Polylines on EAS_FINAL No Open Polylines on MINE_FINAL No Open Polylines on DGM_PROP_FINAL No Open Polylines on AREA_D No Open Polylines on AREA_A Edited October 17, 2022 by mhupp Quote
Guest Posted October 18, 2022 Posted October 18, 2022 Hi mhupp. I want to ask something else for this code If i do this change (setq SS (ssget "_X" '((0 . "*POLYLINE,TEXT") (8 . "PST_KAEK,TOPO_PROP,BLD,VST,EAS,MINE,VST_FINAL,EAS_FINAL,MINE_FINAL,DGM_PROP_FINAL,AREA_D,AREA_A")))) and i want only for PST_KAEK (L1) and BLD (L3) to report (if (>= L1 1) (write-line (strcat "Closed " (rtos L1 2 0) " Polylines on PST_KAEK") F) (write-line (strcat "No Open Polylines on PST_KAEK") F) (write-line (strcat "- " (rtos L1 2 0) " Text on PST_KAEK") F) <--------------- ) (if (>= L3 1) (write-line (strcat "Closed " (rtos L3 2 0) " Polylines on BLD") F) (write-line (strcat "No Open Polylines on BLD") F) (write-line (strcat "- " (rtos L1 2 0) " Text on BLD") F) <-------------- ) What update i have to do in the code? How to count and report the text number ? Thansk Quote
Guest Posted October 18, 2022 Posted October 18, 2022 i was thinking something like this (mapcar '(lambda (x) (set x 0)) '(L1 L2 L3 L4 L5 L6 L7 L8 L9 L10 L11 L12 L13)) (setq sspl (ssget "_X" '((0 . "*POLYLINE") (8 . "PST_KAEK,TOPO_PROP,TOPO_PROP_NEW,BLD,VST,EAS,MINE,VST_FINAL,EAS_FINAL,MINE_FINAL,DGM_PROP_FINAL,AREA_D,AREA_A")))) (setq sstxt (ssget "_X" '((0 . "TEXT") (8 . "PST_KAEK,TOPO_PROP,TOPO_PROP_NEW,BLD,VST,EAS,MINE,VST_FINAL,EAS_FINAL,MINE_FINAL,DGM_PROP_FINAL,AREA_D,AREA_A")))) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex sspl))) (foreach numtxt (vl-remove-if 'listp (mapcar 'cadr (sslength sstxt))) (cond ((eq (setq lay (cdr (assoc 8 (entget poly)))) "PST_KAEK") (setq lay (cdr (assoc 8 (entget numtxt)))) "PST_KAEK") (setq L1 (1+ L1)) ) but i dont know how to (write-line (strcat "- " (rtos L1 2 0) " Text on PST_KAEK") F) Quote
mhupp Posted October 18, 2022 Posted October 18, 2022 Not quite that is multiplying sstxt by ssp1. probably need to do a re-write if you want to count multiple things and do selection sets by layer instead of all at once. Quote
Guest Posted October 18, 2022 Posted October 18, 2022 can you show me an example with 2 layers searching text and polyline? Thanks Quote
Guest Posted October 18, 2022 Posted October 18, 2022 (edited) What about this ? I want to and few things This code close the open polylines and delete the vertex. I want to change 1) If the first and last coordinates of polyline are the same then close the polyline and delete last vertex. If the first and last coordinates of polyline are not the same live the polyline open 2) Write numder of open polylines in layer , the coodinate of the start and end point, and if it close or open 3) Write the number of text in layer and layer name (defun c:test ( / ss ctr obj) (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w")) (if (setq ss (ssget "_X" '((0 . "*POLYLINE") (8 . "Layer1,Layer2,Layer3")))) (progn (setq ctr 0) (repeat (sslength ss) (setq obj (vlax-ename->vla-object (ssname ss ctr))) ;if the pline is NOT closed (if (not (vlax-curve-isClosed obj)) (progn ;if the start and end vertex overlap, remove the last vertex (if (equal (vlax-curve-getPointAtParam obj (vlax-curve-getEndParam obj)) (vlax-curve-getPointAtParam obj (vlax-curve-getStartParam obj))) (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates)))))) );end if start-end ;close the pline (vla-put-Closed obj :vlax-true) (vla-Update obj) ) );enf if pline (setq ctr (1+ ctr)) );end repeat ));end if ss (write-line "" F) (write-line "===========================================================" F) (write-line " Results " F) (write-line "===========================================================" F) (write-line "" F) (if (tblsearch "layer" "Layer1") (write-line (strcat "- Find " (number of open polylines) " polylines to Layer1" (xstart,ystart) (xend,yend) "Open") F) (write-line (strcat "- Find " (number of close polylines) " polylines to Layer1" (xstart,ystart) (xend,yend) "Close") F) (write-line (strcat "- Find " (number of text) " polylines to Layer1" ) F) );end if (if (tblsearch "layer" "Layer2") (write-line (strcat "- Find " (number of open polylines) " polylines to Layer2" (xstart,ystart) (xend,yend) "Open") F) (write-line (strcat "- Find " (number of close polylines) " polylines to Layer2" (xstart,ystart) (xend,yend) "Close") F) (write-line (strcat "- Find " (number of text) " polylines to Layer2" ) F) );end if (if (tblsearch "layer" "Layer3") (write-line (strcat "- Find " (number of open polylines) " polylines to Layer3" (xstart,ystart) (xend,yend) "Open") F) (write-line (strcat "- Find " (number of close polylines) " polylines to Layer3" (xstart,ystart) (xend,yend) "Close") F) (write-line (strcat "- Find " (number of text) " polylines to Layer3" ) F) );end if ; if the numer of lines is 0 dont write the line !!!!! (princ) (write-line "" F) (close F) (startapp "NOTEPAD" txt) (princ) );end defun Thanks Edited October 18, 2022 by prodromosm Quote
ronjonp Posted October 18, 2022 Posted October 18, 2022 (edited) @prodromosm Why do you need a report of these items if you're 'fixing' them as you go ? You can also check if the start and end points are 'equal' like this ... and you should add a fuzz value: (equal (vlax-curve-getstartpoint ename) (vlax-curve-getendpoint ename) 1e-4) Edited October 18, 2022 by ronjonp Quote
Guest Posted October 18, 2022 Posted October 18, 2022 (edited) Hi ronjonp. Thanks for the replay. Can you help me with the code. Can you show for 2 layers and i add more after. Thanks Edited October 18, 2022 by prodromosm Quote
ronjonp Posted October 18, 2022 Posted October 18, 2022 32 minutes ago, prodromosm said: Hi ronjonp. Thanks for the replay. Can you help me with the code. Can you show for 2 layers and i add more after. Thanks Sorry .. I'm only giving you tidbits to help out your learning. Quote
Guest Posted October 19, 2022 Posted October 19, 2022 Thanks ronjonp. But if i had an example is better for me to understand. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.