Help with editing PLIST.lsp

[Anonymous]

Hi,

I've downloaded and used the attached lisp routine with great effect but I wondered if its possible to list the X,Y,Z values with a number in order, for example:

1,579094.359,137991.396,0.000
2,579093.014,137994.12,0.000
3,579091.669,137996.843,0.000
4,579098.024,137999.982,0.000
5,579099.369,137997.258,0.000
6,579100.714,137994.535,0.000

currently I would have to manually input the 1 2 3 4 5 6.

Thanks for any help and suggestions.

Morgan

(defun vert (/ filterlist vla-obj-list
lwlist 2dlist ptlist vlist1
vlist2 vlist3
)
(vl-load-com)
(setq filterlist (make-filter)
vla-obj-list (get-objects filterlist)
lwlist (nth 0 vla-obj-list)
2dlist (nth 1 vla-obj-list)
ptlist (nth 2 vla-obj-list)
vlist1 nil
vlist2 nil
vlist3 nil
) ;_ end-of setq
(if lwlist
(setq vlist1 (make-list lwlist 2))
) ;_ end of if
(if 2dlist
(setq vlist2 (make-list 2dlist 3))
) ;_ end of if
(if ptlist
(setq vlist3 (make-list ptlist 3))
) ;_ end of if
(write-text vlist1 vlist2 vlist3)
(princ)
) ;_ end of vert

(defun make-list (p-list n / i vlist obj coords ca j x y z xy)
(setq i (- 1)
vlist nil
) ;_ end of setq
(repeat (length p-list)
(setq obj (nth (setq i (1+ i)) p-list)
coords (vlax-get-property obj "coordinates")
ca (vlax-variant-value coords)
j (- 1)
) ;_ end-of setq
(repeat (/ (length (vlax-safearray->list ca)) n)
(setq x (vlax-safearray-get-element ca (setq j (1+ j))))
(setq y (vlax-safearray-get-element ca (setq j (1+ j))))
(if (= n 2)
(setq xy (list x y))
(progn
(setq z (vlax-safearray-get-element ca (setq j (1+ j))))
(setq xy (list x y z))
) ;_ end of progn
) ;_ end of if
(setq vlist (append vlist (list xy)))
) ;_ end-of repeat
) ;_ end-of repeat
) ;_ end-of make-list

(defun make-filter (/ filter)
(setq filter '((-4 . "<OR")
(0 . "LWPOLYLINE")
(0 . "POLYLINE")
(0 . "POINT")
(-4 . "OR>")
)
) ;_ end of setq
) ;_ end of make-filter

(defun get-objects (filter / ss k lwp-list
2dp-list pt-list no-ent obj pl
2d pt
)
(setq no-ent 1)
(while no-ent
(setq ss (ssget filter)
k (- 1)
lwp-list nil
2dp-list nil
pt-list nil
obj nil
pl "AcDbPolyline"
2d "AcDb2dPolyline"
pt "AcDbPoint"
) ;_ end-of setq
(if ss
(progn
(setq no-ent nil)
(repeat (sslength ss)
(setq ent (ssname ss (setq k (1+ k)))
obj (vlax-ename->vla-object ent)
) ;_ end-of setq
(cond
((= (vlax-get-property obj "ObjectName") pl)
(setq lwp-list (append lwp-list (list obj)))
)
((= (vlax-get-property obj "ObjectName") 2d)
(setq 2dp-list (append 2dp-list (list obj)))
)
((= (vlax-get-property obj "ObjectName") pt)
(setq pt-list (append pt-list (list obj)))
)
) ;_ end-of cond
) ;_ end-of repeat
) ;_ end-of progn
(prompt "\nNo polylines or points selected, try again.")
) ;_ end-of if
) ;_ end-of while
(list lwp-list 2dp-list pt-list)
) ;_ end-of get-objects

(defun write-text (vl1 vl2 vl3)
(setq fn (getfiled "Text File" "" "txt" 1))
(setq f (close (open fn "w")))
(setq msg "Points from LW-Polylines")
(do-points fn vl1 msg 2)
(setq msg "Points from 2d-Polylines")
(do-points fn vl2 msg 3)
(setq msg "Points from Point entities")
(do-points fn vl3 msg 3)
(princ)
) ;_ end of write-text

(defun do-points (fn vl msg n)
(setq f (open fn "a"))
(write-line msg f)
(write-line " x, y, z" f)
(write-line "" f)
(foreach point vl
(setq x (nth 0 point)
y (nth 1 point)
) ;_ end of setq
(if (= n 2)
(setq str (strcat (rtos x) "," (rtos y)))
(progn
(setq z (nth 2 point))
(setq str (strcat (rtos x) "," (rtos y) "," (rtos z)))
) ;_ end of progn
) ;_ end of if
(write-line str f)
) ;_ end of foreach
(setq f (close f))
(princ)
) ;_ end of defun

(defun c:pts ()
(vert)
(princ)
) ;_ end-of defun

(prompt "PLIST.LSP by Tony Hotchkiss - enter PTS to start ")

[Anonymous]

Try this:

;;---------------------=={ Polyline Information }==---------------------;;
;;                                                                      ;;
;;  This program provides the user with detailed information about      ;;
;;  every segment of a selected polyline in the form of either an       ;;
;;  AutoCAD Table (if available), Text file, or CSV file.               ;;
;;                                                                      ;;
;;  Upon calling the program with the command syntax 'polyinfo' at the  ;;
;;  AutoCAD command-line, the user is prompted to select an LWPolyline  ;;
;;  to be queried from the active drawing. At this prompt the user      ;;
;;  also has the option to choose the form of output for the            ;;
;;  information harvested by the program; this output format will be    ;;
;;  remembered between drawing sessions to enable streamlined repeated  ;;
;;  program usage.                                                      ;;
;;                                                                      ;;
;;  The program will output LWPolyline segment data to either an        ;;
;;  AutoCAD Table Object created in the active drawing (if such object  ;;
;;  is available in the version of AutoCAD in which the program is      ;;
;;  being executed), or a tab-delimited Text file or CSV file           ;;
;;  automatically created (streamlining the program to minimise         ;;
;;  prompts) in the working directory of the active drawing.            ;;
;;                                                                      ;;
;;  For every segment of the selected LWPolyline, the program will      ;;
;;  extract the following information:                                  ;;
;;                                                                      ;;
;;      • Segment Number                                                ;;
;;      • Segment Start Vertex Coordinate                               ;;
;;      • Segment End Vertex Coordinate                                 ;;
;;      • Segment Start Width                                           ;;
;;      • Segment End Width                                             ;;
;;      • Segment Length                                                ;;
;;      • Arc Centre (if arc segment)                                   ;;
;;      • Arc Radius (if arc segment)                                   ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2014  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2012-07-10                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2012-07-16                                      ;;
;;                                                                      ;;
;;  - Added Table & Text file output options.                           ;;
;;  - Removed basic LWPolyline properties.                              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2014-06-14                                      ;;
;;                                                                      ;;
;;  - Fixed bug causing final segment to be omitted from output data    ;;
;;    when processing closed polylines.                                 ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2015-04-13                                      ;;
;;                                                                      ;;
;;  - Fixed bug causing the program to crash when processing polylines  ;;
;;    containing arc segments.                                          ;;
;;----------------------------------------------------------------------;;

(defun c:polyinfo ( / *error* ent enx flg ins lst out seg tmp )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (= 'str (type out)) (setenv "LMac\\PolyInfo" out))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
   
    (if (null (setq out (getenv "LMac\\PolyInfo")))
        (setq out "TXT")
    )
    (princ
        (strcat "\nOutput Format: "
            (cond
                (   (= out "TXT") "Text File")
                (   (= out "CSV") "CSV File")
                (   "AutoCAD Table"   )
            )
        )
    )

    (while
        (progn
            (setvar 'errno 0)
            (initget "Output")
            (setq ent (entsel "\nSelect polyline [Output]: "))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (null ent)
                    nil
                )
                (   (= "Output" ent)
                    (polyinfo:chooseoutput  'out)
                    (setenv "LMac\\PolyInfo" out)
                    (princ
                        (strcat "\nOutput Format: "
                            (cond
                                (   (= out "TXT") "Text File")
                                (   (= out "CSV") "CSV File")
                                (   "AutoCAD Table"   )
                            )
                        )
                    )
                )
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget (setq ent (car ent))))))
                    (princ "\nSelected object is not an LWPolyline.")
                )
            )
        )
    )
    (cond
        (   (and
                (= 'ename (type ent))
                (= "Table" out)
                (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            )
            (princ "\nCurrent layer locked.")
        )
        (   (= 'ename (type ent))
            (setq seg 0
                  enx (entget ent)
                  lst (LM:lwvertices enx)
                  lst
                (cons
                    (append '("SEG." "START X" "START Y" "END X" "END Y" "WIDTH 1" "WIDTH 2" "LENGTH")
                        (if (setq flg (vl-some '(lambda ( x ) (not (zerop (cdr (assoc 42 x))))) lst))
                           '("CENTRE X" "CENTRE Y" "RADIUS")
                        )
                    )
                    (mapcar
                        (function
                            (lambda ( l1 l2 / b p q )
                                (setq p (cdr (assoc 10 l1))
                                      q (cdr (assoc 10 l2))
                                      b (cdr (assoc 42 l1))
                                )
                                (append
                                    (list (itoa (setq seg (1+ seg))))
                                    (mapcar 'rtos p)
                                    (mapcar 'rtos q)
                                    (list
                                        (rtos (cdr (assoc 40 l1)))
                                        (rtos (cdr (assoc 41 l1)))
                                    )
                                    (if (zerop b)
                                        (cons (rtos (distance p q)) (if flg '("" "" "")))
                                        (append
                                            (list (rtos (abs (* (LM:bulgeradius p q b) (atan b) 4))))
                                            (mapcar 'rtos (LM:bulgecentre p q b))
                                            (list (rtos (LM:bulgeradius p q b)))
                                        )
                                    )
                                )
                            )
                        )
                        lst
                        (if (= 1 (logand 1 (cdr (assoc 70 enx))))
                            (append (cdr lst) (list (car lst)))
                            (cdr lst)
                        )
                    )
                )
            )
            (cond
                (   (= out "TXT")
                    (if (LM:writetxt lst (setq tmp (vl-filename-mktemp (cdr (assoc 5 enx)) (getvar 'dwgprefix) ".txt")))
                        (startapp "explorer" tmp)
                    )
                )
                (   (= out "CSV")
                    (if (LM:writecsv lst (setq tmp (vl-filename-mktemp (cdr (assoc 5 enx)) (getvar 'dwgprefix) ".csv")))
                        (startapp "explorer" tmp)
                    )
                )
                (   (setq ins (getpoint "\nSpecify point for table: "))
                    (LM:startundo (LM:acdoc))
                    (LM:addtable  (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) (trans ins 1 0) nil lst nil)
                    (LM:endundo   (LM:acdoc))
                )
            )
        )
    )
    (princ)
)

;; Add Table  -  Lee Mac
;; Generates a table at the given point, populated with the given data and optional title.
;; spc - [vla] VLA Block object
;; ins - [lst] WCS insertion point for table
;; ttl - [str] [Optional] Table title
;; lst - [lst] Matrix list of table cell data
;; eqc - [bol] If T, columns are of equal width
;; Returns: [vla] VLA Table Object

(defun LM:addtable ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid )
    (setq sty
        (vlax-ename->vla-object
            (cdr
                (assoc -1
                    (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))
                        (getvar 'ctablestyle)
                    )
                )
            )
        )
    )
    (setq hgt (vla-gettextheight sty acdatarow))
    (if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))
        (setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))
    )
    (setq wid
        (mapcar
           '(lambda ( col )
                (apply 'max
                    (mapcar
                       '(lambda ( str )
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 str)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                        )
                        col
                    )
                )
            )
            (apply 'mapcar (cons 'list lst))
        )
    )
    (if 
        (and ttl
            (< 0.0
                (setq dif
                    (/
                        (-
                            (   (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))
                                (textbox
                                    (list
                                        (cons 01 ttl)
                                        (cons 40 hgt)
                                        (cons 07 stn)
                                    )
                                )
                            )
                            (apply '+ wid)
                        )
                        (length wid)
                    )
                )
            )
        )
        (setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))
    )
    (setq obj
        (vla-addtable spc
            (vlax-3D-point ins)
            (1+ (length lst))
            (length (car lst))
            (* 2.0 hgt)
            (if eqc
                (apply 'max wid)
                (/ (apply '+ wid) (float (length (car lst))))
            )
        )
    )
    (vla-put-regeneratetablesuppressed obj :vlax-true)
    (vla-put-stylename obj (getvar 'ctablestyle))
    (setq i -1)
    (if (null eqc)
        (foreach col wid
            (vla-setcolumnwidth obj (setq i (1+ i)) col)
        )
    )
    (if ttl
        (progn
            (vla-settext obj 0 0 ttl)
            (setq i 1)
        )
        (progn
            (vla-deleterows obj 0 1)
            (setq i 0)
        )
    )
    (foreach row lst
        (setq j 0)
        (foreach val row
            (vla-settext obj i j val)
            (setq j (1+ j))
        )
        (setq i (1+ i))
    )
    (vla-put-regeneratetablesuppressed obj :vlax-false)
    obj
)

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil

(defun LM:writecsv ( lst csv / des sep )
    (if (setq des (open csv "w"))
        (progn
            (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
            (foreach row lst (write-line (LM:lst->csv row sep) des))
            (close des)
            t
        )
    )
)

;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token

(defun LM:lst->csv ( lst sep )
    (if (cdr lst)
        (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
        (LM:csv-addquotes (car lst) sep)
    )
)

(defun LM:csv-addquotes ( str sep / pos )
    (cond
        (   (wcmatch str (strcat "*[`" sep "\"]*"))
            (setq pos 0)    
            (while (setq pos (vl-string-position 34 str pos))
                (setq str (vl-string-subst "\"\"" "\"" str pos)
                      pos (+ pos 2)
                )
            )
            (strcat "\"" str "\"")
        )
        (   str   )
    )
)

;; Write Text File  -  Lee Mac
;; Writes a matrix of values to a tab-delimited Text file.
;; lst - [lst] list of lists, sublist is line of text values
;; txt - [str] filename of Text file to write
;; Returns T if successful, else nil

(defun LM:writetxt ( lst txt / des )
    (if (setq des (open txt "w"))
        (progn
            (foreach itm lst (write-line (LM:lst->str itm "\t") des))
            (close des)
            t
        )
    )
)

;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item

(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)

;; Annotative-p  -  Lee Mac
;; Predicate function to determine whether a Text Style is annotative.
;; sty - [str] Name of Text Style

(defun LM:annotative-p ( sty )
    (and (setq sty (tblobjname "style" sty))
         (setq sty (cadr (assoc -3 (entget sty '("AcadAnnotative")))))
         (= 1 (cdr (assoc 1070 (reverse sty))))
    )
)

;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline

(defun LM:lwvertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:lwvertices (cdr e))
        )
    )
)

;; Bulge Radius  -  Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b  - bulge
;; Returns the radius of the arc described by the given bulge and vertices

(defun LM:bulgeradius ( p1 p2 b )
    (/ (* (distance p1 p2) (1+ (* b b))) 4 (abs b))
)

;; Bulge Centre  -  Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b  - bulge
;; Returns the centre of the arc described by the given bulge and vertices

(defun LM:bulgecentre ( p1 p2 b )
    (polar p1
        (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
        (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
    )
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com)
(eval
    (append
        (list 'defun 'polyinfo:chooseoutput '( sym ))
        (if (vlax-method-applicable-p (vla-get-modelspace (LM:acdoc)) 'addtable)
            (list
               '(initget "Table TXT CSV")
               '(set sym (cond ((getkword (strcat "\nChoose Output [Table/TXT/CSV] <" (eval sym) ">: "))) ((eval sym))))
            )
            (list
               '(initget "TXT CSV")
               '(set sym (cond ((getkword (strcat "\nChoose Output [TXT/CSV] <" (eval sym) ">: "))) ((eval sym))))
            )
        )
    )
)

(princ
    (strcat
        "\n:: PolyInfo.lsp | Version 1.3 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"polyinfo\" to Invoke ::"
    )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

Júnior Nogueira.

Por favor,  Aceitar como Solução se meu post te ajudar.

Please Accept as Solution if my post helps you.

[Anonymous]

Thanks but im using this lisp to extract information on points not polylines, it dosent seem to work for that.

[Anonymous]

I'm sorry, will the numbering of the points be random?

Júnior Nogueira.

Por favor,  Aceitar como Solução se meu post te ajudar.

Please Accept as Solution if my post helps you.

[pbejse · Accepted solution]

---

---

@Anonymous wrote:

...possible to list the X,Y,Z values with a number in order, for example: 

---

Replace do-points with the modified code below

(defun do-points (fn vl msg n / prefix)
  (Setq prefix 1)
  (setq f (open fn "a"))
  (write-line msg f)
  (write-line " x, y, z" f)
  (write-line "" f)
  (foreach point vl
    (setq x (nth 0 point)
	  y (nth 1 point)
    ) ;_ end of setq
    (if	(= n 2)
      (setq str (strcat (itoa prefix) "," (rtos x) "," (rtos y)))
      (progn
	(setq z (nth 2 point))
	(setq str (strcat (itoa prefix) ","  (rtos x) "," (rtos y) "," (rtos z)))
      ) ;_ end of progn
    ) ;_ end of if
    (write-line str f)
    (setq prefix (1+ prefix))
  ) ;_ end of foreach
  (setq f (close f))
  (princ)
)

-

HTH 

[Anonymous]

Amazing, thanks so much!

Morgan.

[pbejse]

---

@Anonymous wrote:

Amazing, thanks so much!

Morgan.

---

You are welcome Morgan

Cheers