I know this sounds like it has been answered before, but I haven't found it anywhere.
I have been using the area command for getting the total length of polylines by checking the perimeter output, but I've been notified I need the total length of the pline and also the total length of the curved segments.
I've used vla-getbulge to redraw a single segment of a pline and I suspect I can use it to filter lines from arcs in the *Polyline. Below is what I have this far
(SETQ SS (SSGET)) (WHILE (> (SSLENGTH SS) 0) (SETQ SN (SSNAME SS 0) Ent (ENTGET SN) ETyp (CDR (ASSOC '0 Ent)) ) (COND ((OR (= ETyp "LWPOLYLINE") (= ETyp "POLYLINE")) (SETQ Pt (VLAX-CURVE-GETCLOSESTPOINTTO Ent *PIK_pnt*) Param1 (FIX (VLAX-CURVE-GETPARAMATPOINT Ent Pt)) Param2 (1+ Param1) StPt (VLAX-CURVE-GETPOINTATPARAM Ent Param1) EndPt (VLAX-CURVE-GETPOINTATPARAM Ent Param2) Bulge (VLA-GETBULGE (VLAX-ENAME->VLA-OBJECT Ent) Param1) Chord (DISTANCE StPt EndPt) Len (+ Len Chord) ) (IF (/= Bulge 0.0) (SETQ CurvLen (+ CurvLen Chord))) (SSDEL SN SS) ) ) ) (ALERT (STRCAT "The Total Length is: " (RTOS Len 4 6) "\nAnd, The Total Length of Curves is: " (RTOS CurvLen 4 6) ) )
This gets me part of the way there, but I need help to cycle through every segment of the *Polyline to get the combined totals. I suspect a lambda is needed, but how to implement properly?
(to avoid confusion: I need the complete total of all segment lengths :Lines and arcs: & also a seperate total of all curved segments.)
Thank you for any help and/or advice.
Solved! Go to Solution.
Solved by Lee_Mac. Go to Solution.
Solved by dbroad. Go to Solution.
Won't the length property work for each polyline?
(vla-get-length <polylineobject>)
To convert ename to object, just use:
(setq pobj (vlax-ename->vla-object ename))
I'm sure it will. The thing is, I'm already in a loop through a collection of plines, and I still need to sort through and total the segments with the bulge parameter in order to report two totals.
Sorry. Missed your point.
I would try a different approach. 1)Filter objects as part of the selection. 2)Use vla-methods
This should get you halfway there.
(defun test (/ doc tlen blen) (if (ssget '((0 . "LWPOLYLINE, POLYLINE"))) (progn (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq tlen 0) (setq blen 0) (vlax-for n (vla-get-activeselectionset doc) ;;already filtered for appropriate objects (setq tlen (+ tlen (vla-get-length n))) (setq param 0) ;;might need cond here to account for old style polylines (while (< param (vlax-curve-getendparam n)) (if (/= (vla-getbulge n param) 0) (setq blen (+ blen (- (vlax-curve-getdistatparam n (1+ param)) (vlax-curve-getdistatparam n param) ) ) ) ) (setq param (1+ param)) ) ) ) ) (list tlen blen) )
Here are another two variations for fun:
(defun c:test1 ( / arc ent idx par sel tot ) (if (setq sel (ssget '((0 . "LWPOLYLINE")))) (progn (setq tot 0.0 arc 0.0 ) (repeat (setq idx (sslength sel)) (setq ent (ssname sel (setq idx (1- idx))) par (vlax-curve-getendparam ent) tot (+ tot (vlax-curve-getdistatparam ent par)) ) (repeat (fix par) (if (not (equal '(0.0 0.0 0.0) (vlax-curve-getsecondderiv ent (setq par (1- par))) 1e-8 ) ) (setq arc (+ arc (- (vlax-curve-getdistatparam ent (1+ par)) (vlax-curve-getdistatparam ent par) ) ) ) ) ) ) (princ (strcat "\n Total length: " (rtos tot 4 6) "\nCurved length: " (rtos arc 4 6) ) ) ) ) (princ) ) (vl-load-com) (princ)
Obfuscated vanilla version:
(defun c:test2 ( / _lwvertices enx idx lst rtn sel ) (defun _lwvertices ( enx ) (if (setq enx (member (assoc 10 enx) enx)) (cons (cons (cdr (assoc 10 enx)) (cdr (assoc 42 enx)) ) (_lwvertices (cdr enx)) ) ) ) (if (setq sel (ssget '((0 . "LWPOLYLINE")))) (progn (setq rtn '(0.0 0.0)) (repeat (setq idx (sslength sel)) (setq enx (entget (ssname sel (setq idx (1- idx)))) lst (_lwvertices enx) rtn (apply 'mapcar (vl-list* '+ rtn (mapcar '(lambda ( a b / d ) (if (equal 0.0 (cdr a) 1e-8) (list (distance (car a) (car b)) 0.0) (list (setq d (* (/ (distance (car a) (car b)) (* 2.0 (sin (* 2.0 (atan (cdr a)))))) (* (atan (cdr a)) 4.0) ) ) d ) ) ) lst (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (append (cdr lst) (list (car lst))) (cdr lst) ) ) ) ) ) ) (mapcar '(lambda ( a b ) (princ a) (princ (rtos b 4 6))) '("\n Total length: " "\nCurved length: ") rtn ) ) ) (princ) )
You're welcome mid-awe, I'm glad the examples are useful -
If you have any questions about the lambda functions or other parts of the code, just ask.
Lee
Is it safe to say that the time that the
(mapcar
'(lambda
statements are most commonly used when you must construct a defun on the fly (processing) and apply it to the ss created by a preceding SSget?(list to process)
I have this for preceding ssget. The lisp create a field with cumul length or area of selected objects
(vl-load-com) (defun c:cumul_measure2field ( / js htx AcDoc Space str k_mod n ename nw_obj pt key) (or (setq js (ssget "_I")) (setq js (ssget "_P")) ) (cond (js (sssetfirst nil js) (initget "Existant Nouveau _Existent New") (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New") (progn (sssetfirst nil nil) (setq js (ssadd) js (ssget))) ) ) (T (setq js (ssget))) ) (cond (js (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) str "" ) (cond ((null (tblsearch "LAYER" "Mesures cumulees")) (vlax-put (vla-add (vla-get-layers AcDoc) "Mesures cumulees") 'color 96) ) ) (initget "Longueur Aire _Length Area") (setq k_mod (getkword "\nMesurer [Longueur/Aire] <Longueur> : ")) (if (not k_mod) (setq k_mod "Length")) (repeat (setq n (sslength js)) (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n))))) (if (eq k_mod "Length") (foreach typ_measure '("Length" "ArcLength" "Circumference" "Perimeter") (if (vlax-property-available-p ename (read typ_measure)) (setq str (strcat str "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%)." typ_measure " \\f \"%lu2%pr2\">%" "+" ) ) ) ) (if (vlax-property-available-p ename "Area") (setq str (strcat str "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr2\">%" "+" ) ) ) ) ) (cond ((/= str "") (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar (getvar "VIEWCTR") (* pi 0.5) (getvar "TEXTSIZE")))) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcExpr (" (substr str 1 (1- (strlen str))) ") \\f \"%lu2%pr2\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill) (list 5 (getvar "TEXTSIZE") 5 pt "Standard" "Mesures cumulees" 0.0 0) ) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (vlax-put nw_obj 'InsertionPoint (trans (cadr key) 1 0)) ) ) ) ) (T (princ "\nLes objets sélectionnés n'ont pas la propriété requise")) ) ) ) (prin1) )