Elimina vertice da polilinea

Details

Category: Lisp

Published on Tuesday, 06 December 2011 20:58

Hits: 301

Il seguente codice serve per estrarre il valore dei vertici di una polilinea e li salva in un file di testo.

(Defun C:ScrivipolyXYZ ()
   (Setq Pol (Entsel "\n....... Seleziona La Polilinea: ")) 
   (Setq Separatore (Getstring "\n... Carattere Separatore Di Num X Y Z: "))
   (Setq Nomefile
   (Getfiled "File Txt Con Le Coordinate Della Polilinea"
   (Getvar "Dwgprefix") "Txt"1))
   (If (And Pol Nomefile)
     (Progn 
        (If (= Separatore "") (Setq Separatore " ") ) 
        (Setq Ff (Open Nomefile "W")) 
        (If (= (Cdr (Assoc 0 (Entget (Car Pol)))) "LWPOLYLINE") 
          (Progn 
             (Setq Li-Crea Nil)
             (Setq Conta 0)
             (Setq I 0) 
             (setq Z(Cdr (Assoc 38 (Entget (Car Pol)))))
             (Repeat (Length (setq lwp(entget(car pol))))
             (Setq Lwele (Nth I Lwp)) 
             (If (= (Car Lwele) 10) (Progn (Setq X (Cadr Lwele))
               (Setq Y (Caddr Lwele))
               (Setq Xconta (Itoa (Setq Conta (+ Conta 1))))
               (Write-Line 
                  (Strcat
                     Xconta Separatore (Rtos X 2 2)
                     Separatore (Rtos Y 2 2) Separatore (Rtos Z 2 2) 
                  ) Ff 
               ) 
             ) 
          ) 
       (Setq I (+ I 1)) 
    )
    (Close Ff)
 ))
 (If (= (Cdr (Assoc 0 (Entget (Car Pol)))) "POLYLINE")
 (Progn 
   (Setq Li-Crea Nil)
   (Setq Pol-Princ (Entget (Car Pol)))
   (Setq Vertice (Entnext (Car Pol))) 
   (Setq Vert (Entget Vertice)) (Setq Conta 0) 
   (While (/= (Cdr (Assoc 0 Vert)) "SEQEND")
   (Setq X (Car (Cdr (Assoc 10 Vert))))
   (Setq Y (Cadr (Cdr (Assoc 10 Vert)))) 
   (Setq Z (Caddr (Cdr (Assoc 10 Vert))))
   (Setq Conta (+ Conta 1))
   (Setq Xconta (Itoa Conta))
   (Write-Line 
     (Strcat XcontaSeparatore (Rtos X 2 2) 
        Separatore (Rtos Y 2 2) Separatore (Rtos Z 2 2)
     ) Ff 
   )
   (Setq Vertice (Entnext Vertice)) 
   (Setq Vert (Entget Vertice))
 )
 (Close Ff) 
)) 
(alert (Strcat "Creato Il File: " Nomefile)) (princ) ) ) ) 
(Princ "\n Digitare ScrivipolyXYZ Per Lanciare Il Programma!")
(Princ) 

• < Prev
• Next >