Author Topic: combined length of lines  (Read 2638 times)

0 Members and 1 Guest are viewing this topic.

Ron Heigh

  • Guest
combined length of lines
« on: September 22, 2004, 10:13:50 AM »
There was a routine that would give the total length of all the lines/arcs selected in the drawing.
Does anybody remember where it was postsd?

whdjr

  • Guest
combined length of lines
« Reply #1 on: September 22, 2004, 10:21:56 AM »
Ron,
This will give you the lengths of lines and plines.  I never tested it on arcs though.
Code: [Select]
(defun adddist (listlengths)
  (apply '+ listlengths)
)

(defun xy_list (alist / cnt dlist)
  (setq cnt 0)
  (repeat (/ (length alist) 2)
    (setq dlist (cons (list (nth cnt alist)
   (nth (+ 1 cnt) alist)
     )
     dlist
)
 cnt (+ 2 cnt)
    )
  )
  (reverse dlist)
)


(defun llen (en)
  (setq llens (cons (vla-get-length (vlax-ename->vla-object en)) llens))
)

(defun getcoords (obj)
  (xy_list (vlax-safearray->list
    (vlax-variant-value
      (vla-get-coordinates obj)
    )
  )
  )
)


(defun pllen ( en / obj stparam endparam coords ptlength dist)
  (setq obj (vlax-ename->vla-object en)
stParam (vlax-curve-getStartParam obj)
endParam (vlax-curve-getEndParam obj)
coords (getcoords obj)
ptlength (length coords)
  )
  (while (< stparam ptlength)
    (setq dist  (- (vlax-curve-getDistAtParam obj (1+ stparam))
    (vlax-curve-getDistAtParam obj stparam)
 )
 stparam (1+ stparam)
 pllens  (cons dist pllens)
    )
  )
)

(defun c:ll (/ sset len ssn ent llens pllens linelens plinelens)
  (setq sset (ssget '((0 . "LINE,LWPOLYLINE")))
  )
  (if sset
    (progn
      (repeat (setq len (sslength sset))
(setq len (1- len)
     ssn (ssname sset len)
     ent (entget ssn)
)
(cond ((= (cdr (assoc 0 ent)) "LINE")(llen ssn))
     ((= (cdr (assoc 0 ent)) "LWPOLYLINE")(pllen ssn))
)
      )
      (setq linelens  (adddist llens)
   plinelens (adddist pllens)
      )
      (setq num (rtos num 2 0)
   len (rtos len 4)
      )
      (alert (strcat num " line lengths = " len))
    )
  )
)


HTH,

Ron Heigh

  • Guest
combined length of lines
« Reply #2 on: September 22, 2004, 10:50:28 AM »
Thank you for the post.
I modified the code to this.
Code: [Select]
(DEFUN C:LL (/ X SS:MAIN SS:LINE SS:ARC LNUM ANUM LLEN TLEN)
  (SETQ ;SS:MAIN (SSGET '((0 . "LINE,LWPOLYLINE,ARC")))
SS:LINE (SSGET '((0 . "LINE,LWPOLYLINE")))
SS:ARC (SSGET '((0 . "ARC")))
LNUM 0
LLEN 0
ANUM 0
ALEN 0
  )
  (IF SS:LINE
    (PROGN
      (REPEAT (SSLENGTH SS:LINE)
(SETQ LLEN
      (+ LLEN
 (VLA-GET-LENGTH
   (VLAX-ENAME->VLA-OBJECT (SSNAME SS:LINE LNUM))
 )
      )
)
(SETQ LNUM (1+ LNUM))
      )
    )
  )

  (SETQ ANUM 0)

  (IF SS:ARC
    (PROGN
      (REPEAT (SSLENGTH SS:ARC)
(SETQ ALEN
      (+ ALEN
 (VLA-GET-ARCLENGTH
   (VLAX-ENAME->VLA-OBJECT (SSNAME SS:ARC ANUM))
 )
      )
)
(SETQ ANUM (1+ ANUM))
      )
      (SETQ TLEN (+ ALEN LLEN)
   ANUM (RTOS ANUM 2 0)
   ALEN (RTOS ALEN 4)
   LNUM (RTOS LNUM 2 0)
   LLEN (RTOS LLEN 4)
   TLEN (RTOS TLEN 4)
      )
      (ALERT (STRCAT LNUM " line lengths = " LLEN "\n" ANUM " arc lenghs = " alen "\nTotal length = " TLEN))
    )
  )
)

JohnK

  • Administrator
  • Seagull
  • Posts: 10625
combined length of lines
« Reply #3 on: September 22, 2004, 10:54:12 AM »
Mark wrote that (well a routine like the one your talking about), Ill look arround for it. (It was cool!)



edit reason: clara-faction
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
combined length of lines
« Reply #4 on: September 22, 2004, 11:40:22 AM »
Here is another routine, author unknown. untested.


Code: [Select]
(defun entLen (/ set:OfEnts int:l rea:LengthOfEnts)
  (setq set:OfEnts  (ssget)
        int:l 0
        rea:LengthOfEnts 0.0
  ) ;_ setq
  (while (< int:l (sslength set:OfEnts))
    (setq rea:LengthOfEnts
           (+ rea:LengthOfEnts
              (vlax-curve-getdistatparam
                (vlax-ename->vla-object (ssname set:OfEnts int:l))
                (vlax-curve-getendparam (ssname set:OfEnts int:l))
              ) ;_ vlax-curve-getDistAtParam
           ) ;_ +
    ) ;_ setq
    (setq int:l (1+ int:l))
  ) ;_ while
  (princ (strcat "\nEntities: - "
                 (itoa (sslength set:OfEnts))
                 "\nTotal Lengh: - "
                 (rtos rea:LengthOfEnts)
         ) ;_ strcat
  ) ;_ princ
  (prin1)
) ;_ defun
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.