;;---------------------=={ 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
)
(LM:endundo (LM:acdoc))
)
)
)
( (= out "TXT") "Text File")
( (= out "CSV") "CSV File")
( "AutoCAD Table" )
)
)
)
(setq ent
(entsel "\nSelect polyline [Output]: ")) (princ "\nMissed, try again.") )
nil
)
( (= "Output" ent)
(polyinfo:chooseoutput 'out)
( (= out "TXT") "Text File")
( (= out "CSV") "CSV File")
( "AutoCAD Table" )
)
)
)
)
(princ "\nSelected object is not an LWPolyline.") )
)
)
)
(= "Table" out)
)
(princ "\nCurrent layer locked.") )
lst (LM:lwvertices enx)
lst
(append '
("SEG." "START X" "START Y" "END X" "END Y" "WIDTH 1" "WIDTH 2" "LENGTH") '("CENTRE X" "CENTRE Y" "RADIUS")
)
)
)
)
)
)
)
)
)
lst
)
)
)
)
( (= out "TXT")
)
)
( (= out "CSV")
)
)
(LM:startundo (LM:acdoc))
(LM:endundo (LM:acdoc))
)
)
)
)
)
;; 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 hgt
(vla
-gettextheight sty acdatarow
)) (if (LM:annotative
-p
(setq stn
(vla
-gettextstyle sty acdatarow
))) )
)
)
)
)
col
)
)
)
)
)
(< 0.0
(/
(-
)
)
)
)
)
)
)
)
)
(vla-addtable spc
(* 2.0 hgt)
)
)
)
(vla-put-regeneratetablesuppressed obj :vlax-true)
(vla
-setcolumnwidth obj
(setq i
(1+ i
)) col
) )
)
(vla-settext obj 0 0 ttl)
)
(vla-deleterows obj 0 1)
)
)
(vla-settext obj i j val)
)
)
(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
) (setq sep
(cond ((vl
-registry
-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (","))) 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
) (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
) (setq str
(vl
-string
-subst "\"\"" "\"" str pos
) pos (+ pos 2)
)
)
)
( 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
) 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
) )
)
;; 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
) )
)
;; 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
) )
)
)
)
;; 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
) )
;; 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
) (+ (angle p1 p2
) (- (/ pi
2) (* 2 (atan b
)))) )
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo
( doc
) (LM:endundo doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo
( doc
) )
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(LM:acdoc)
)
(list '
defun 'polyinfo:chooseoutput '
( sym
)) )
)
)
)
)
"\n:: PolyInfo.lsp | Version 1.3 | \\U+00A9 Lee Mac "
" www.lee-mac.com ::"
"\n:: Type \"polyinfo\" to Invoke ::"
)
)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;