Jump to content

Help : Close open polylines ,delete extra vertex,and report

Guest

By Guest
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

  • Replies 36
  • Created
  • Last Reply

Top Posters In This Topic

  • mhupp

    12

  • ronjonp

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhupp
mhupp

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 an

mhupp Grand Master

mhupp

Posted
Posted (edited)

Got rid of all the repeating  code. just update the laylst at the start with the layers you want to check.

  

(defun c:FOO (/ laylst SSP SST lst obj F TXT)
  (setq laylst '("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 lay laylst
    (setq SSP nil SST nil) ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )
    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay)))))
      (setq SST (ssadd))
    )
    (setq lst (cons (list lay (rtos (sslength SSP) 2 0) (rtos (sslength SST) 2 0)) lst))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      );end if start-end
      (vla-put-Closed obj :vlax-true) 
      (vla-Update obj)
    )
  )
  (setq lst (reverse lst))
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
  (write-line "=========================================================" F)
  (write-line "                          Results                        " F)
  (write-line "=========================================================" F)
  (foreach line lst
    (write-line (strcat "Layer: " (car line)) F)
    (if (eq (cadr line) "0")
      (write-line "No Open Polylines Found" F)
      (write-line (strcat (cadr line) " Polyline Closed") F)
    )
    (if (eq (caddr line) "0")
      (write-line "No Text Found" F)    
      (write-line (strcat (caddr line) " Text Found") F)
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

 

=========================================================
                                                     Results                        
=========================================================
Layer: PST_KAEK
1 Polyline Closed
5 Text Found
Layer: TOPO_PROP
No Open Polylines Found
No Text Found

Edited by mhupp
Guest

Guest

Posted
Posted (edited)

Hi mhupp. Thanks for the code. I try to add a filter to print result only for exist layers .  Is no need to print the other extra lines !! I Block the line to close the polyline and i prefare to count and report the open and not write "No Open Polylines Found"

 

  

(defun c:FOO (/ laylst SSP SST lst obj F TXT)
  (setq laylst '("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 lay laylst
    (setq SSP nil SST nil) ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )
    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay)))))
      (setq SST (ssadd))
    )
    (setq lst (cons (list lay (rtos (sslength SSP) 2 0) (rtos (sslength SST) 2 0)) lst))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      );end if start-end
     ; (vla-put-Closed obj :vlax-true) ;This could add gemoetiry somewhere you don't want  <--- I do this change
      (vla-Update obj)
    )
  )
  (setq lst (reverse lst))
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
  (write-line "=========================================================" F)
  (write-line "                          Results                        " F)
  (write-line "=========================================================" F)

  (foreach line lst
    (if (tblsearch "layer" (car line))  ; <------ I add this line
    (write-line (strcat "Layer: " (car line)) F)
	) ; <------ I add this line
    (if (eq (cadr line) "0")
      (write-line "No Open Polylines Found" F)
      (write-line (strcat (cadr line) " Polyline Closed") F)
    )
    (if (eq (caddr line) "0")
      (write-line "No Text Found" F)    
      (write-line (strcat (caddr line) " Text Found") F)
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

 

Quote

 

=========================================================
                          Results                        
=========================================================
Layer: PST_KAEK
No Open Polylines Found
1 Text Found
Layer: TOPO_PROP
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found
Layer: BLD
No Open Polylines Found
4 Text Found
Layer: VST
No Open Polylines Found
3 Text Found
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found
Layer: VST_FINAL
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found
No Open Polylines Found
No Text Found

 

 

 

 

 

Edited by prodromosm
Guest

Guest

Posted
Posted

I update the code. I have an error

 

Quote

; error: bad argument type: stringp #<file "C:\\Users\\Prodromos\\appdata\\local\\temp\\TEXTFILE.TXT">

 

And i want to add a line 

  

        (write-line (strcat "- Found " (cadr line) " Open Polyline to Layer " (car line)) F)

 

  

(defun c:FOO (/ laylst SSP SST lst obj F TXT)
  (setq laylst '("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 lay laylst
    (setq SSP nil SST nil) ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )
    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay)))))
      (setq SST (ssadd))
    )
    (setq lst (cons (list lay (rtos (sslength SSP) 2 0) (rtos (sslength SST) 2 0)) lst))
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      );end if start-end
      ;(vla-put-Closed obj :vlax-true) 
      (vla-Update obj)
    )
  )
  (setq lst (reverse lst))
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
  
  (write-line "=========================================================" F)
  (write-line "                          Results                        " F)
  (write-line "=========================================================" F)
  (foreach line lst
    (if (=(tblsearch "layer" (car line)))
        (write-line (strcat "- Found " (cadr line) " Close Polyline to Layer " (car line)) F)
    )
	
    (if (eq (caddr line) "0")
      (write-line (strcat "- Found 0 Text to Layer " (car line)) F)    
      (write-line (strcat "- Found " (caddr line) " Text to Layer " (car line) F))
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

 

 

mhupp Grand Master

mhupp

Posted
Posted (edited)

Error Hit

https://www.cadtutor.net/forum/topic/76177-help-close-open-polylines-delete-extra-vertexand-report/?do=findComment&comment=602139

 

Good idea, prob best to layer check when making the list tho. This will take care of both outputs for poly and text if the layer isn't in the drawing. 

(if (tblsearch "layer" lay)
  (setq lst (cons (list lay (rtos (sslength SSP) 2 0) (rtos (sslength SST) 2 0)) lst))
)
...
(if (eq (cadr line) "0")
  (write-line (strcat "- Found 0 Open Polyline on Layer " (car line)) F)
  (write-line (strcat "- Found & Closed " (cadr line) " Open Polyline on Layer " (car line)) F)
)

 

Edited by mhupp
Guest

Guest

Posted
Posted

Hi mhupp. I try to add a second list of layers only for the text .Visual lisp editor can not find any errors but when i run the lisp have this message. Can you help?

 

Quote

; error: bad argument type: stringp nil

 

  

(defun c:test (/ laylst SSP SST lst obj F TXT)
  (setq laylst '("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 laylst2 '("DBOUND_AIG" "DBOUND_PRL" "DBOUND_PAIG" "DBOUND_REM" "DBOUND_APAL" "DBOUND_APAL" "ROAD" "OT" "PST_KAEK" "BLD" "VST" "EAS"))
  (foreach lay laylst
           lay2 laylst2
    (setq SSP nil SST nil) ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )
    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay)))))
      (setq SST (ssadd))
    )
    (if (tblsearch "layer" lay)
    (setq lst (cons (list lay (rtos (sslength SSP) 2 0)) lst))
    )
	    (if (tblsearch "layer" lay2)
    (setq 2nd (cons (list lay2 (rtos (sslength SST) 2 0)) 2nd))
    )
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      );end if start-end
      (vla-put-Closed obj :vlax-true) 
      (vla-Update obj)
    )
  )
  (setq lst (reverse lst))
  (setq 2nd (reverse 2nd))
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
  
  (write-line "=========================================================" F)
  (write-line "                          Results                        " F)
  (write-line "=========================================================" F)
  (foreach line lst
(if (eq (cadr line) "0")
  (write-line (strcat "- " (cadr line) " Polyline found on Layer " (car line)) F)
)
    (if (eq (caddr line) "0")
      (write-line (strcat "- " (caddr line) " Text found on Layer " (car line) F))
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

 

Thanks

mhupp Grand Master

mhupp

Posted
Posted (edited)

Just add them to laylst.

  

(setq laylst '("PST_KAEK" "TOPO_PROP" "TOPO_PROP_NEW" "BLD" "VST" "EAS" "MINE" 
                 "VST_FINAL" "EAS_FINAL" "MINE_FINAL" "DGM_PROP_FINAL" "AREA_D" 
                 "AREA_A" "DBOUND_AIG" "DBOUND_PRL" "DBOUND_PAIG" "DBOUND_REM" 
                 "DBOUND_APAL" "DBOUND_APAL" "ROAD" "OT" "PST_KAEK" "BLD" "VST" 
                 "EAS")
  )

 

Edited by mhupp
Guest

Guest

Posted
Posted (edited)

Hi mhupp.I make a second laylist because I don't want to search for polylines in these layers and not write "0 polylines in layer  ...........  ". I want to search only for text in this laylist.Is it possible to have a second laylist?

The idea is to have something like this 

(write-line "============================================================" F)
(write-line "                 Close Polyline & Layers                    " F)
(write-line "============================================================" F)




  
(write-line "=========================================================" F)
(write-line "                          Text & Layers                  " F)
(write-line "=========================================================" F)

 

 

Thanks

Edited by prodromosm
mhupp Grand Master

mhupp

Posted
Posted

If that is what you want to do your going to have to make a separate foreach for the 2nd list. that generates a separate list to output to the text file.

  

laylst1
laylst2
foreach laylst1
...
foreach laylst2
...
(write-line "============================================================" F)
(write-line "                 Close Polyline & Layers                    " F)
(write-line "============================================================" F)
foreach line lstPoly
...
(write-line "=========================================================" F)
(write-line "                          Text & Layers                  " F)
(write-line "=========================================================" F)
foreach line lstText
...

 

 

 

 

Guest

Guest

Posted
Posted

Hi mhupp.I did the change. The code works but the results in not correct.I have close polylines in the drowing and the result say 0 close polyline !!. For the text say nothing

  

(defun c:test (/ laylst SSP SST lstPoly lstText obj F TXT)
  (setq laylst1 '("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 laylst2 '("DBOUND_AIG" "DBOUND_PRL" "DBOUND_PAIG" "DBOUND_REM" "DBOUND_APAL" "DBOUND_APAL" "ROAD" "OT" "PST_KAEK" "BLD" "VST" "EAS"))
   ;-------------laylist1----------------------------------------------
  (foreach lay laylst1
    (setq SSP nil) ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )

    (if (tblsearch "layer" lay)
    (setq lstPoly (cons (list lay (rtos (sslength SSP) 2 0)) lstPoly))
    )

    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      );end if start-end
      (vla-put-Closed obj :vlax-true) 
      (vla-Update obj)
    )
  )
  ;-------------laylist2----------------------------------------------
  
  (foreach lay2 laylst2
    (setq SST nil) ;clear last selection sets

    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay2)))))
      (setq SST (ssadd))
    )
 	(if (tblsearch "layer" lay2)
    (setq lstText (cons (list lay2 (rtos (sslength SST) 2 0)) lstText))
    )

  )
  ;--------------------------------------------------------------------------------
  
  (setq lstPoly (reverse lstPoly))
  (setq lstText (reverse lstText))
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
 
 ;-------------write laylist1---------------------------------------------- 
(write-line "============================================================" F)
(write-line "                 Close Polyline & Layers                    " F)
(write-line "============================================================" F)
(write-line "" F)
  (foreach line lstPoly
    (if (eq (cadr line) "0")
    (write-line (strcat "- " (cadr line) " Close Polyline found on Layer " (car line)) F)
	)
  )
  
 ;-------------write laylist2----------------------------------------------
(write-line "=========================================================" F)
(write-line "                          Text & Layers                  " F)
(write-line "=========================================================" F)
(write-line "" F)
  (foreach line lstText
    (if (eq (caddr line) "0")
    (write-line (strcat "- " (caddr line) " Text found on Layer " (car line) F))
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

test file.dwg

mhupp Grand Master

mhupp

Posted
Posted

change your if statements.

 

  

(if (not (eq (caddr line) "0")) ;either add a not will only display layers that have a count 
or
(if (eq (caddr line) "0")) ;will display all layers 0's and #'s
  (write-line (strcat "- 0 Close Polyline found on Layer " (car line)) F)
  (write-line (strcat "- " (cadr line) " Close Polyline found on Layer " (car line)) F)
)

 

Guest

Guest

Posted
Posted (edited)

in the previous code we have this 

(if (eq (cadr line) "0")
  (write-line (strcat "- " (cadr line) " Polyline found on Layer " (car line)) F)
)
    (if (eq (caddr line) "0")
      (write-line (strcat "- " (caddr line) " Text found on Layer " (car line) F))
    )
  )

 

I did your change anyway but i have this error

Quote

; error: bad argument type: stringp nil

 

I confused !!!!!!

  

(defun c:test (/ laylst SSP SST lstPoly lstText obj F TXT)
  (setq laylst1 '("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 laylst2 '("DBOUND_AIG" "DBOUND_PRL" "DBOUND_PAIG" "DBOUND_REM" "DBOUND_APAL" "DBOUND_APAL" "ROAD" "OT" "PST_KAEK" "BLD" "VST" "EAS"))
   ;-------------laylist1----------------------------------------------
  (foreach lay laylst1
    (setq SSP nil) ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )

    (if (tblsearch "layer" lay)
    (setq lstPoly (cons (list lay (rtos (sslength SSP) 2 0)) lstPoly))
    )

    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      );end if start-end
      (vla-put-Closed obj :vlax-true) 
      (vla-Update obj)
    )
  )
  ;-------------laylist2----------------------------------------------
  
  (foreach lay2 laylst2
    (setq SST nil) ;clear last selection sets

    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay2)))))
      (setq SST (ssadd))
    )
 	(if (tblsearch "layer" lay2)
    (setq lstText (cons (list lay2 (rtos (sslength SST) 2 0)) lstText))
    )

  )
  ;--------------------------------------------------------------------------------
  
  (setq lstPoly (reverse lstPoly))
  (setq lstText (reverse lstText))
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
 
 ;-------------write laylist1---------------------------------------------- 
(write-line "============================================================" F)
(write-line "                 Close Polyline & Layers                    " F)
(write-line "============================================================" F)
(write-line "" F)
  (foreach line lstPoly
   (if (not (eq (caddr line) "0"))
    (write-line (strcat "- " (cadr line) " Close Polyline found on Layer " (car line)) F)
	)
  )
  
 ;-------------write laylist2----------------------------------------------
(write-line "=========================================================" F)
(write-line "                          Text & Layers                  " F)
(write-line "=========================================================" F)
(write-line "" F)
  (foreach line lstText
    (if (not (eq (caddr line) "0"))
    (write-line (strcat "- " (caddr line) " Text found on Layer " (car line) F))
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

 

 

Edited by prodromosm
mhupp Grand Master

mhupp

Posted
Posted

In my code i had two outputs 

  if true

  if false

 

Yours only has one so it only outputs if true

  

(if (eq (cadr line) "0")
  (write-line (strcat "- Found & Closed 0 Open Polyline on Layer " (car line)) F) ;if true output this line
  (write-line (strcat "- Found & Closed " (cadr line) " Open Polyline on Layer " (car line)) F) ;if false output this line
)

You changed it to 

(if (eq (cadr line) "0")
  (write-line (strcat "- " (cadr line) " Polyline found on Layer " (car line)) F)
  ;missing false write-line
)

Because their isn't a false statment this will only output when true
and since its only true "0" it will only output "- Found & Closed 0 Open Polyline on Layer "layername"

This will output anything that isn't equal to 0
(if (not (eq (cadr line) "0"))
  (write-line (strcat "- " (cadr line) " Polyline found on Layer " (car line)) F)
)

 

but that's not whats is causing the error its the write-line again. the list only has two elements now.

Error 1 - (caddr line) is nil since their isn't a third element

Error 2 - and having ) in the wrong place

  

(write-line (strcat "- " (caddr line) " Text found on Layer " (car line) F)) ;wrong
(write-line (strcat "- " (cadr line) " Text found on Layer " (car line)) F) ;right

 

fixed code 

(defun c:test (/ laylst SSP SST lstPoly lstText obj F TXT)
  (setq laylst1 '( "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 laylst2 '( "DBOUND_AIG" "DBOUND_PRL" "DBOUND_PAIG" "DBOUND_REM" "DBOUND_APAL" "DBOUND_APAL" "ROAD" "OT" "PST_KAEK" "BLD" "VST" "EAS"))
  ;-------------laylist1----------------------------------------------
  (foreach lay laylst1
    (setq SSP nil)  ;clear last selection sets
    (if (not (setq SSP (ssget "_X" (list '(0 . "*POLYLINE") (cons 8 lay) '(70 . 0)))))
      (setq SSP (ssadd))
    )
    (if (tblsearch "layer" lay)
      (setq lstPoly (cons (list lay (rtos (sslength SSP) 2 0)) lstPoly))
    )
    (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SSP)))
      (if (and (setq obj (vlax-ename->vla-object poly)) (equal (vlax-curve-getstartpoint poly) (vlax-curve-getendpoint poly) 1e-4))
        (vlax-put obj 'Coordinates (reverse (cdr (cdr (reverse (vlax-get obj 'Coordinates))))))
      )  ;end if start-end
      (vla-put-Closed obj :vlax-true)
      (vla-Update obj)
    )
  )
  ;-------------laylist2----------------------------------------------
  (foreach lay2 laylst2
    (setq SST nil)  ;clear last selection sets
    (if (not (setq SST (ssget "_X" (list '(0 . "TEXT") (cons 8 lay2)))))
      (setq SST (ssadd))
    )
    (if (tblsearch "layer" lay2)
      (setq lstText (cons (list lay2 (rtos (sslength SST) 2 0)) lstText))
    )
  )
  (setq lstPoly (reverse lstPoly))
  (setq lstText (reverse lstText))
  ;-------------write laylist1---------------------------------------------- 
  (setq F (open (setq txt (strcat (getvar "TEMPPREFIX") "TEXTFILE.TXT")) "w"))
  (write-line "============================================================" F)
  (write-line "                     Close Polyline & Layers                " F)
  (write-line "============================================================" F)
  (write-line "" F)
  (foreach line lstPoly
    (if (not (eq (cadr line) "0"))
      (write-line (strcat "- " (cadr line) " Close Polyline found on Layer " (car line)) F)
    )
  )
  ;-------------write laylist2----------------------------------------------
  (write-line "" F)
  (write-line "============================================================" F)
  (write-line "                       Text & Layers                        " F)
  (write-line "============================================================" F)
  (write-line "" F)
  (foreach line lstText
    (if (not (eq (cadr line) "0"))
      (write-line (strcat "- " (cadr line) " Text found on Layer " (car line)) F)
    )
  )
  (close F)
  (startapp "NOTEPAD" txt)
  (princ)
)  ;end defun

 

will output

 

============================================================
                                             Close Polyline & Layers                    
============================================================

- 3 Close Polyline found on Layer BLD

=========================================================
                                                    Text & Layers                  
=========================================================

- 1 Text found on Layer ROAD
- 1 Text found on Layer PST_KAEK
- 2 Text found on Layer BLD
- 3 Text found on Layer VST

Guest

Guest

Posted
Posted

Thanks for your time mhupp, but the code still not working properly because i have close polylines in layers

VST_FINAL
PST_KAEK
VST

 

and i have no results for them !!!!!

 

Thanks

 

 

Guest

Guest

Posted
Posted

I understand sory.Your code finds only the open polylines and report that close a number of them, not report all close polyline in the layer. OK

 

Thanks

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...