Me ajudem a editar essa LISP.

Me ajudem a editar essa LISP.

Anonymous
Not applicable
1,456 Views
1 Reply
Message 1 of 2

Me ajudem a editar essa LISP.

Anonymous
Not applicable

Encontrei uma Lisp aqui no fórum e não consigo editá-la, a lisp funciona da seguinte maneira, ela exporta as coordenadas X, Y, Z de uma Polyline e transforma em um arquivo .txt, Só que eu não gostaria que ela exportasse  a polyline, e sim um posto clicável  de no lugar de selecionar a  polyne ser a coordenada do ponto que eu clicar , Ex: cliquei  em qualquer ponto ela gera as coordenadas XYZ do ponto que eu cliquei.

;........................................................

(defun ERR (S)
(if (= S "Function cancelled")
(princ "\nVERTEXT - cancelled: ")
(progn (princ "\nVERTEXT - Error: ") (princ S) (terpri)) ;_ progn
) ;_ if
(RESETTING)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
) ;_ err
(defun SETV (SYSTVAR NEWVAL)
(setq X (read (strcat SYSTVAR "1")))
(set X (getvar SYSTVAR))
(setvar SYSTVAR NEWVAL)
) ;_ setv
(defun SETTING ()
(setq OERR *ERROR*)
(setq *ERROR* ERR)
(SETV "CMDECHO" 0)
(SETV "BLIPMODE" 0)
) ;_ end of setting
(defun RSETV (SYSTVAR)
(setq X (read (strcat SYSTVAR "1")))
(setvar SYSTVAR (eval X))
) ;_ restv
(defun RESETTING ()
(RSETV "CMDECHO")
(RSETV "BLIPMODE")
(setq *ERROR* OERR)
) ;_ end of resetting

(defun DXF (CODE ENAME) (cdr (assoc CODE (entget ENAME)))) ;_ dxf

(defun VERTEXT (/ EN VLIST)
(setq EN (GET-EN))
(if (= (DXF 0 EN) "LWPOLYLINE")
(setq VLIST (GET-LWVLIST EN))
(setq VLIST (GET-PLVLIST EN))
) ;_ if
(WRITE-IT VLIST EN)
) ;_ vertext

(defun GET-EN (/ NO-ENT EN MSG1 MSG2)
(setq NO-ENT 1
EN NIL
MSG1 "\nSelect a polyline: "
MSG2 "\nNo polyline selected, try again."
) ;_ setq
(while NO-ENT
(setq EN (car (entsel MSG1)))
(if (and EN
(or (= (DXF 0 EN) "LWPOLYLINE") (= (DXF 0 EN) "POLYLINE")) ;_ or
) ;_ and
(progn (setq NO-ENT NIL)) ; progn
(prompt MSG2)
) ;_ if
) ;_ while
EN
) ;_ get-en

(defun GET-LWVLIST (EN / ELIST NUM-VERT VLIST)
(setq ELIST (entget EN)
NUM-VERT (cdr (assoc 90 ELIST))
ELIST (member (assoc 10 ELIST) ELIST)
VLIST NIL
) ;_ setq
(repeat NUM-VERT
(setq VLIST (append VLIST (list (cdr (assoc 10 ELIST)))) ; append
) ;_ setq
(setq ELIST (cdr ELIST)
ELIST (member (assoc 10 ELIST) ELIST)
) ;_ setq
) ;_ repeat
VLIST
) ;_ get-lwvlist

(defun GET-PLVLIST (EN / VLIST)
(setq VLIST NIL
EN (entnext EN)
) ;_ setq
(while (/= "SEQEND" (DXF 0 EN))
(setq VLIST (append VLIST (list (DXF 10 EN))))
(setq EN (entnext EN))
) ;_ while
VLIST
) ;_ get-plvlist

(defun WRITE-IT (VLST EN / NEWVLIST MSG3 FNAME)
(setq NEWVLIST (mapcar '(lambda (X) (trans X EN 0)) ;_ lambda
VLST
) ;_ mapcar
MSG3 "Polyline vertex file"
FNAME (getfiled MSG3 "" "txt" 1)
F1 (open FNAME "w")
) ;_ setq
(WRITE-HEADER)
(WRITE-VERTICES NEWVLIST)
(setq F1 (close F1))
) ;_ write-it

(defun WRITE-HEADER (/ STR)
(setq STR " POLYLINE VERTEX POINTS")
(write-line STR F1)
(setq STR (strcat " X " " Y " " Z") ;_ strcat
) ;_ setq
(write-line STR F1)
) ;_ write-header

(defun WRITE-VERTICES (NEWVLIST / XSTR YSTR ZSTR STR)
(foreach ITEM NEWVLIST
(setq XSTR (rtos (nth 0 ITEM) 2 4)
YSTR (rtos (nth 1 ITEM) 2 4)
ZSTR (rtos (nth 2 ITEM) 2 4)
STR (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR) ;_ strcat
) ;_ setq
(write-line STR F1)
) ;_ foreach
) ;_ write-vertices

(defun SPACES (STR / FIELD NUM CHAR SPACE)
(setq FIELD 15
NUM (- FIELD (strlen STR))
CHAR " "
SPACE ""
) ;_ setq
(repeat NUM (setq SPACE (strcat SPACE CHAR))) ;_ repeat
) ;_ spaces

(defun C:VTX ()
(SETTING)
(VERTEXT)
(RESETTING)
(princ)
) ;_ c:vtx

(prompt "\nEnter VTX to start")

 

0 Likes
1,457 Views
1 Reply
Reply (1)
Message 2 of 2

marko_ribar
Advisor
Advisor

Here try this :

 

(defun c:clickedpoints2csv ( / *error* blm p pl ch prec fn filename n )

  (defun *error* ( m )
    (if blm
      (if (getenv "BLIPMODE")
        (setenv "BLIPMODE" blm)
        (setvar 'blipmode blm)
      )
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (if (getenv "BLIPMODE")
    (setq blm (getenv "BLIPMODE"))
    (setq blm (getvar 'blipmode))
  )
  (if (getenv "BLIPMODE")
    (setenv "BLIPMODE" "1")
    (setvar 'blipmode 1)
  )
  (setq n 0)
  (while (setq p (getpoint (strcat "\nClick on point " (itoa (setq n (1+ n))) " ... ENTER TO FINISH : ")))
    (setq pl (cons p pl))
  )
  (setq pl (reverse pl))
  (prompt (strcat "\nLast point " (itoa n) " is not specified due to FINISHED WHILE LOOP point specifications..."))
  (initget 1 "UCS WCS")
  (setq ch (getkword "\nSpecify coordinate system [UCS/WCS] : "))
  (if (= ch "WCS")
    (setq pl (mapcar '(lambda ( p ) (trans p 1 0)) pl))
  )
  (initget 7)
  (setq prec (getint "\nSpecify precision decimal places of point data coordinate specifications : "))
  (princ "\n")
  (setq fn (open (setq filename (getfiled "Specify csv filename and path where to save point data list" (getvar 'dwgprefix) "csv" 1)) "w"))
  (write-line "POINT LIST SPECIFICATIONS" fn)
  (write-line "" fn)
  (write-line " NO , X , Y , Z " fn)
  (setq n 0)
  (foreach p pl
    (setq n (1+ n))
    (write-line (strcat " " (itoa n) " , " (rtos (car p) 2 prec) " , " (rtos (cadr p) 2 prec) " , " (rtos (caddr p) 2 prec) " ") fn)
  )
  (close fn)
  (startapp "EXPLORER" filename)
  (*error* nil)
)

Regards...

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes