Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Data Extraction from Polylines and Arcs

7 REPLIES 7
Reply
Message 1 of 8
gilbertomejiac
3782 Views, 7 Replies

Data Extraction from Polylines and Arcs

¿There is a AutoLISP for extract START and END coordinates in X, Y, and Z planes, and extract length of Polylines and Arcs.?

 

Thanks 

7 REPLIES 7
Message 2 of 8


@gilbertomejiac wrote:

¿There is a AutoLISP for extract START and END coordinates in X, Y, and Z planes, and extract length of Polylines and Arcs.?

 

Thanks 


Look for examples of the (vlax-curve-getStartPoint) and (vlax-curve-getEndPoint) functions.  They will work on Polylines, Arcs, Circles, Lines [yes, they qualify as "curves" by these functions' definition], Ellipses, and Splines.

 

For the lengths of objects, you can subtract the results of (vlax-curve-getDistAtPoint) functions using the start and end points.  However, for closed objects [Circles, closed Polylines/Ellipses/Splines], subtracting the distance at the start Point from the distance at the end Point returns 0.  You can get around that by using (vlax-curve-getDistAtParam) using the starting and ending Parameter values, instead of using Point values [again, a Search will give you many examples].

 

The (vlax-curve...) functions will work with entity names.  If you convert an entity to a VLA object [look for examples of (vlax-ename->vla-object)], you can get its VLA Properties.  Those include start and end points and lengths for some entity types, but not all, and lengths are under different Property names in some cases [Length for a Line, Circumference for a Circle], so the (vlax-curve-...) approach would be more universal.

Kent Cooper, AIA
Message 3 of 8

Thanks for your response.

 

there is a developed LISP routine that allow me to extract in a MS Excel sheet file, every line, arc and Polyline properties like: Start coordinates, end coordinates, and Lenght.

 

This is from a specified layer

 

Thanks.

Message 4 of 8
alanjt_
in reply to: Kent1Cooper

To build on Kent's post, all you need are three vlax-curve* functions.

 

vlax-curve-getStartPoint

vlax-curve-getEndPoint

vlax-curve-getDistAtPoint

 

Now, you can use the first two avove functions to attain your start and end points. For the length of any curve (polyline, line, arc, ellipse, circle, whatever I'm forgetting), since you have the end point alredy stored (vlax-curve-getEndPoint), you can just use (vlax-curve-getDistAtPoint <entity> (vlax-curve-getEndPoint <entity>)) to retrieve the length of any valid curve. There is no need to subtract this from the distance at the start point.

 

This should get you started:

 

(defun _XYZ&Length (entity / ep)
  (if (eq (type entity) 'ENAME)
    (list (list (vlax-curve-getStartPoint entity) (setq ep (vlax-curve-getEndPoint entity)))
          (vlax-curve-getDistAtPoint entity ep)
    )
  )
)

 

 

 

 

Message 5 of 8
Kent1Cooper
in reply to: alanjt_


@alanjt_ wrote:

....you can just use (vlax-curve-getDistAtPoint <entity> (vlax-curve-getEndPoint <entity>)) to retrieve the length of any valid curve. There is no need to subtract this from the distance at the start point.

....


However, (vlax-curve-getDistAtPoint <entity> (vlax-curve-getEndPoint <entity>)) returns 0 if the entity is closed.  [Maybe that's not a possibility for what they're doing.]
 

But this:

(vlax-curve-getDistAtParam <entity> (vlax-curve-getEndParam <entity>))

returns the correct length for any entity type, open or closed.

 

[I was probably thinking about subtracting because of a routine I was working on recently in which I needed the distance between two locations, but for a total length, you're right that no subtracting is required.]

 

I don't have experience with feeding those things out to something like an Excel file, though I could spell out a way to send them to a plain text file.

Kent Cooper, AIA
Message 6 of 8
alanjt_
in reply to: Kent1Cooper

I did not realize that. I always use the param vlax-curve* functions to extract the entity lengh and I admit to assuming the point would work the same, just to save processing power on extracting entity data.

 

In that case, disregard my earlier post. I should have checked first.

 

Here's my length function:

 

(defun AT:Length (ent)
  ;; Return length of curve
  ;; Alan J. Thompson, 08.06.10
  (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
)

 

Message 7 of 8

I found a routine, but don't know if it works

 

 

Spoiler
(vl-load-com)
(defun c:mult-info_po2cell ( / js obj ename n AcDoc Space pr nb lst_id-seg lst_pt lst_length lst_alpha lst_rad id all_path j end_pos id_path fonts_path file_shx
nw_obj nw_style dist_start dist_end pt_start pt_end seg_len seg_bulge rad alpha oldim oldlay h_t w_c ename_cell n_row n_column)
(princ "\nSelect polylines.")
(while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
(princ "\nSelection empty, or is not a available polyline!")
)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(cond
((null (tblsearch "LAYER" "Table-Polyline"))
(vla-add (vla-get-layers AcDoc) "Table-Polyline")
)
)
(cond
((null (tblsearch "STYLE" "Text-Cell"))
(setq all_path (getenv "ACAD") j 0)
(while (setq end_pos (vl-string-position (ascii ";") all_path))
(setq id_path (substr all_path 1 end_pos))
(if (wcmatch (strcase id_path) "*FONTS*")
(setq fonts_path (strcat id_path "\\"))
)
(setq all_path (substr all_path (+ 2 end_pos)))
)
(setq file_shx (getfiled "Select a font file " fonts_path "shx" 8))
(if (not file_shx)
(setq file_shx "txt.shx")
)
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Cell"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
(command "_.ddunits"
(while (not (zerop (getvar "cmdactive")))
(command pause)
)
)
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
)
(setvar "dimzin" 0) (setvar "clayer" "Table-Polyline")
(initget 9)
(setq ins_pt_cell (getpoint "\nLeft-Up insert point of table: "))
(initget 6)
(setq h_t (getdist ins_pt_cell (strcat "\nHigth text <" (rtos (getvar "textsize")) ">: ")))
(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
(initget 7)
(setq w_c (getdist ins_pt_cell "\nWidth of cells: "))
(setq
lst_id-seg '()
lst_pt '()
lst_length '()
lst_alpha '()
lst_rad '()
nb 0
id 0
)
(repeat (setq n (sslength js))
(setq
obj (ssname js (setq n (1- n)))
ename (vlax-ename->vla-object obj)
pr -1
id (1+ id)
)
(repeat (fix (vlax-curve-getEndParam ename))
(setq
dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
pt_start (vlax-curve-GetPointAtParam ename pr)
pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
seg_len (- dist_end dist_start)
seg_bulge (vla-GetBulge ename pr)
rad (if (zerop seg_bulge) 0.0 (/ seg_len (* 4.0 (atan seg_bulge))))
alpha (if (zerop seg_bulge) (angle pt_start pt_end) 0.0)
lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg)
lst_pt (cons pt_start lst_pt)
lst_length (cons seg_len lst_length)
lst_rad (cons (abs rad) lst_rad)
lst_alpha (cons alpha lst_alpha)
nb (1+ nb)
)
)
(if (eq (vla-get-closed ename) :vlax-false)
(setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg))
(setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa (- nb (fix (vlax-curve-getEndParam ename))))) lst_id-seg))
)
(setq
lst_pt (cons pt_end lst_pt)
lst_length (cons 0.0 lst_length) lst_rad (cons 0.0 lst_rad) lst_alpha (cons 0.0 lst_alpha)
nb (1+ nb)
)
)
(mapcar
'(lambda (p tx)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point p)
0.0
tx
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list 5 h_t 5 p "Text-Cell" "Table-Polyline" 0.0)
)
)
lst_pt
lst_id-seg
)
(vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 2 nb) 6 (+ h_t (* h_t 0.25)) w_c)
(setq ename_cell (vlax-ename->vla-object (entlast)) n_row (1+ nb) n_column -1)
(vla-SetCellValue ename_cell 0 0
(vlax-make-variant
(strcat "Summary of " (itoa (sslength js)) " LWPOLYLINES")
8
)
)
(vla-SetCellTextStyle ename_cell 0 0 "Text-Cell")
(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
(vla-SetCellAlignment ename_cell 0 0 5)
(foreach n
(mapcar'list
(append lst_id-seg '("N°"))
(append (mapcar 'rtos (mapcar 'car lst_pt)) '("Coordinates X"))
(append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("Coordinates Y"))
(append (mapcar 'rtos lst_length) '("Lengths"))
(append (mapcar 'angtos lst_alpha) '("Directions"))
(append (mapcar 'rtos lst_rad) '("Radius"))
)
(mapcar
'(lambda (el)
(vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column))
(if (or (eq (rtos 0.0) el) (eq (angtos 0.0) el)) (vlax-make-variant "_" 8) (vlax-make-variant el 8))
)
(vla-SetCellTextStyle ename_cell n_row n_column "Text-Cell")
(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
(if (eq n_row 1)
(vla-SetCellAlignment ename_cell n_row n_column 5)
(vla-SetCellAlignment ename_cell n_row n_column 6)
)
)
n
)
(setq n_row (1- n_row) n_column -1)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(prin1)
)

 

Maybe, the problem with your dwg is due to polylines that you select... I've made this one that will convert old polylines into new lwpolylines and check for overlapping start and end vertex. If they overlap it will automatically remove last vertex and modify lwpolyline to be closed... So here is code you should start before c:rebar...

Spoiler
(defun c:2dpolysupdate ( / ENDXF10 ENTPL INCR PLDXF PLDXFN SS STDXF10 )
(vl-cmdf "_.convert" "p" "a")
(while (not (eq (getvar 'cmdactive) 0)) (vl-cmdf ""))
(prompt "\nSelect old and new 2dpolylines")
(setq ss (ssget '((0 . "LWPOLYLINE")) ))
(repeat (setq incr (sslength ss))
(setq entpl (ssname ss (setq incr (1- incr)) ))
(setq pldxf (entget entpl))
(setq stdxf10 (assoc 10 pldxf))
(setq endxf10 (assoc 10 (reverse pldxf)))
(if (equal stdxf10 endxf10 1e-8)
(progn
(setq pldxfn (append (reverse (cdr (member (assoc 10 (reverse pldxf)) (reverse pldxf)))) (list (list 210 0.0 0.0 1.0))))
(entmod (setq pldxfn (subst (cons 90 (- (cdr (assoc 90 pldxfn)) 1)) (assoc 90 pldxfn) pldxfn)))
(entmod (subst (cons 70 1) (assoc 70 pldxfn) pldxfn))
)
)
) 
(princ)
)

 

 

 

 

Message 8 of 8
pbejse
in reply to: gilbertomejiac


@gilbertomejiac wrote:

I found a routine, but don't know if it works

   


You tell us gilbertomejiac, Does it do what you're want to achieve?

 

Or you meant dont know how to work it?

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost