Looking for a lsp that adds the total length of lines/plines/arcs, but separately for straight lines (and polyline segment) and for each group of arcs (and arc polyline segment) with the same radius

Looking for a lsp that adds the total length of lines/plines/arcs, but separately for straight lines (and polyline segment) and for each group of arcs (and arc polyline segment) with the same radius

jakob.holmquistGRCUL
Enthusiast Enthusiast
7,304 Views
20 Replies
Message 1 of 21

Looking for a lsp that adds the total length of lines/plines/arcs, but separately for straight lines (and polyline segment) and for each group of arcs (and arc polyline segment) with the same radius

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Hi!

I'm in need of a lisp routine that will help me calculate the amount of curbstones a drawing contains. In my country we are to specify the total lenght of straight curbstones, and total length of circular curbstones for each unique radius so that the contractor can order the correct amount of materials when building. So the lisp needs to go through all objects in one specific layer called M-DEC---E1N and add the total length of each line and straight part of polylines, and do the same for every unique radius for all arcs and arc segments of polylines. Preferably it would be presented in a table and would look something like this:

 

Segment           Radius          Total length

Straight line          -                          150

Arc                          1.5                        25

Arc                          2                           32

Arc                          6                           14.2

and so on.

I attached a dwg with an example of some polylines, arcs and lines and a table, where the table is supposed to be the output of the lisp.

 

I have found this lisp that calculates the combined length of all plines/arcs/lines for each layer that I believe was created by a user called phanaem. Maybe it can be modified to work as I stated above, but as I am a beginner at programming in lisp this is out of my reach. Any help is really appreciated! 

 

(defun C:LAYLENGTH ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
      (insert_table l p)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons (mapcar '(lambda (a) (strcat "Col" (itoa (1+ (vl-position a (car lst)))))) (car lst)) lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list lst))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  
  (setq lst (cons '("TITLE") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )

 

 

0 Likes
Accepted solutions (1)
7,305 Views
20 Replies
Replies (20)
Message 21 of 21

Kent1Cooper
Consultant
Consultant

@jakob.holmquistGRCUL wrote:

... 2D polylines are not accepted as selection, and their lengths are therefore not calculated. I tried adding "POLYLINE" in the part of the code that specifies what sort of objects are accepted as selection, ... but their lengths were not calculated, neither the straight or arc segments. ....


For that part, if they're going to be processed in the same way, rather than an (or) function checking for both types separately, you can check for both types at once, like this:

 

((wcmatch (vlax-get to 'objectname) "AcDbPolyline,AcDb2dPolyline")

 

Kent Cooper, AIA
0 Likes