How to get a total length of polyline with curves length total?

[mid-awe]

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.

[dbroad]

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))

[mid-awe]

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.

[dbroad · Accepted solution]

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)
)

[mid-awe]

Thank you. Works great. I made a few changes to work within my existing code, but other than that no problems. =D

[dbroad]

You're welcome.  Thanks for the Kudos.

[Lee_Mac · Accepted solution]

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)
)

[mid-awe]

Thank you. Very interesting methods here. I'm particularly interested in the lambda functions. Never seem to get a good grasp on best times and places to utilize them.

[Lee_Mac]

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

[bhull1985]

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)

[CADaSchtroumpf]

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)
)