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,308 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,309 Views
20 Replies
Replies (20)
Message 2 of 21

hak_vz
Advisor
Advisor

Here is your code not fully tested.  Modifications possible next year. Happy New Year!

(defun c:curbscount ( / *error* create_table_header table_add_row ss lel str_segs_length curved_list i todel tlel lel eo todel)
	;author hak_vz  
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;Posted at
	;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/looking-for-a-lsp-that-adds-the-total-length-of-lines-plines/td-p/10850094
	;Thursday, December 30, 2021
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ (strcat "\nError: " msg))
		)
		(if acdoc (vla-endundomark acdoc))
		(princ)
	)
	 (defun create_table_header (title lst_headers lst_column_widths / pt i column headers lst_column_widths)
  
        (setq pt (vlax-3d-point (getpoint "\nSelect table insertion point >")))
        (if (and pt)
            (progn
                (setq table
                    (vla-addtable
                        (vla-get-modelspace acdoc)
                         pt
                            2           ; number of rows
                            (length lst_headers)			; number of colums
                            0.5			    ; cell height
                            5			; cell  width
                    )
                    i 0
                )
                (vla-setText table 0 0 title)
                (foreach column lst_headers
                    (vla-setText table 1 i column)
                    (vla-SetcolumnWidth table i (nth i lst_column_widths))
                (setq i (+ i 1))
                )
            )
        )
        (vla-endundomark acdoc) 
        (princ)
    )
    (defun table_add_row (table lst_data / i newrow)
        (cond 
            ((not (vlax-erased-p table))
                (vla-endundomark acdoc) 
                (vla-startundomark acdoc)    
                (vla-put-RegenerateTableSuppressed table :vlax-true)
                (setq 
                    newrow (vla-Get-Rows table)
                    i 0
                )
                (vla-InsertRows table newrow 1 1)
                (vla-setrowheight table newrow 0.5)
                (foreach col lst_data
                    (vla-setText table newrow i col)
                    (setq i (+ i 1))
                )
                
                ;(vla-put-RegenerateTableSuppressed table :vlax-false)
                (vla-RecomputeTableBlock table :vlax-true)
                (vla-endundomark acdoc)
            )
        )        
        (princ)
    )
	(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
	(princ "\nSelect all curbs polylines in layer M-DEC---E1N >")
	(setq ss (ssget '((0 . "LWPOLYLINE")(8 . "M-DEC---E1N"))) i -1)
	(setq lel (entlast))
	(setq str_segs_length 0)
	(setq curved_list (list))
	(while (< (setq i (1+ i))(sslength ss))
		(command "_.copy" (ssname ss i) "" '(0 0 0) '(0 0 0))
		(command "_.explode" (entlast))
		(setq todel nil)
		(setq tlel lel)
		(while (setq tlel (entnext tlel))
			(setq eo (vlax-ename->vla-object tlel))
			(cond 
				((= (vlax-get eo 'ObjectName) "AcDbLine")
					(setq str_segs_length (+ str_segs_length (vlax-get eo 'Length)))
					(setq todel (cons tlel todel))
				)
				((= (vlax-get eo 'ObjectName) "AcDbArc")
					(setq rad (vlax-get eo 'Radius))
					(setq len(vlax-get eo 'ArcLength))
					(cond 
						((and (setq m (assoc rad curved_list)))
						  (setq tot (cadr m))
						  (setq newtot (+ tot len))
						  (setq curved_list (subst (list rad newtot) (assoc rad curved_list) curved_list))
						)
						(T
							(setq curved_list (cons (list rad len)curved_list))
						)
					)
					(setq todel (cons tlel todel))	
				)
			)
		)
		(foreach el todel (entdel el))
	)
	(create_table_header "Total lenghts" '("" "Radius" "Total length") '(5 5 5))
	(table_add_row table (list "Straight line" "-"  (rtos str_segs_length 2 3)))
	(foreach ent curved_list
	(table_add_row table (list "Arc" (rtos (car ent) 2 1) (rtos (cadr ent) 2 3)))
	)
(princ)
)

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 3 of 21

john.uhden
Mentor
Mentor

@jakob.holmquistGRCUL 

What radius do you want to use for a spline?

John F. Uhden

0 Likes
Message 4 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Splines can be disregarded, in my organization we normally draw curbstones as just lines and polylines.

0 Likes
Message 5 of 21

ronjonp
Mentor
Mentor

@hak_vz 

Here's another version that removes the command calls and uses (setq olst (vlax-invoke (vlax-ename->vla-object (ssname ss i)) 'explode)) to create the objects.

(defun c:curbscount
       (/ *error* acdoc curved_list i lel len m newtot olst rad ss str_segs_length table tot)
					;author hak_vz  
					;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
					;Posted at
					;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/looking-for-a-lsp-that-adds-the-total-length-of-lines-plines/td-p/10850094
					;Thursday, December 30, 2021
  (defun *error* (msg)
    (if	(not (member msg '("Function cancelled" "quit / exit abort")))
      (princ (strcat "\nError: " msg))
    )
    (if	acdoc
      (vla-endundomark acdoc)
    )
    (princ)
  )
  (defun create_table_header
	 (title lst_headers lst_column_widths / pt i column headers lst_column_widths)
    (setq pt (vlax-3d-point (getpoint "\nSelect table insertion point >")))
    (if	(and pt)
      (progn (setq table (vla-addtable
			   (vla-get-modelspace acdoc)
			   pt
			   2		; number of rows
			   (length lst_headers) ; number of colums
			   0.5		; cell height
			   5		; cell  width
			 )
		   i	 0
	     )
	     (vla-settext table 0 0 title)
	     (foreach column lst_headers
	       (vla-settext table 1 i column)
	       (vla-setcolumnwidth table i (nth i lst_column_widths))
	       (setq i (+ i 1))
	     )
      )
    )
    (vla-endundomark acdoc)
    (princ)
  )
  (defun table_add_row (table lst_data / i newrow)
    (cond ((not (vlax-erased-p table))
	   (vla-endundomark acdoc)
	   (vla-startundomark acdoc)
	   (vla-put-regeneratetablesuppressed table :vlax-true)
	   (setq newrow	(vla-get-rows table)
		 i	0
	   )
	   (vla-insertrows table newrow 1 1)
	   (vla-setrowheight table newrow 0.5)
	   (foreach col lst_data (vla-settext table newrow i col) (setq i (+ i 1)))
					;(vla-put-RegenerateTableSuppressed table :vlax-false)
	   (vla-recomputetableblock table :vlax-true)
	   (vla-endundomark acdoc)
	  )
    )
    (princ)
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (princ "\nSelect all curbs polylines in layer M-DEC---E1N >")
  (setq	ss (ssget '((0 . "LWPOLYLINE") (8 . "M-DEC---E1N")))
	i  -1
  )
  (setq lel (entlast))
  (setq str_segs_length 0)
  (setq curved_list (list))
  (while (< (setq i (1+ i)) (sslength ss))
;;;  (command "_.copy" (ssname ss i) "" '(0 0 0) '(0 0 0))
;;;  (command "_.explode" (entlast))
;;;  (setq todel nil)
;;;  (setq tlel lel)
    ;; List of vla-objects to iterate
    (setq olst (vlax-invoke (vlax-ename->vla-object (ssname ss i)) 'explode))
    (foreach eo	olst
      (cond ((= (vlax-get eo 'objectname) "AcDbLine")
	     (setq str_segs_length (+ str_segs_length (vlax-get eo 'length)))
	    )
	    ((= (vlax-get eo 'objectname) "AcDbArc")
	     (setq rad (vlax-get eo 'radius))
	     (setq len (vlax-get eo 'arclength))
	     (cond ((and (setq m (assoc rad curved_list)))
		    (setq tot (cadr m))
		    (setq newtot (+ tot len))
		    (setq curved_list (subst (list rad newtot) (assoc rad curved_list) curved_list))
		   )
		   (t (setq curved_list (cons (list rad len) curved_list)))
	     )
	    )
      )
    )
    (mapcar 'vla-delete olst)
    ;; (foreach el todel (entdel el))
  )
  (create_table_header "Total lenghts" '("" "Radius" "Total length") '(5 5 5))
  (table_add_row table (list "Straight line" "-" (rtos str_segs_length 2 3)))
  (foreach ent curved_list
    (table_add_row table (list "Arc" (rtos (car ent) 2 1) (rtos (cadr ent) 2 3)))
  )
  (princ)
)

 

Message 6 of 21

hak_vz
Advisor
Advisor

@ronjonp I like the way you've modified my code.

Both solutions work OK. I have built this by reusing some of my older code and more as a concept.

It is a good idea to remove command calls.

 

At first I had an idea to use polyline bulges and make calculations for each segment, but this option with exploding

polyline to lines and arc seamed easier to do.

 

@jakob.holmquistGRCUL You can accept both or any code as solution to your request. Try both codes and share with

us how you see it and do you have any further requests.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 7 of 21

Sea-Haven
Mentor
Mentor

I got involved in a project where we used sawn bluestone, the company made curved sections as well, so we had to do a full list of straight lengths and curve plans so they could cut the stone, the lengths sometimes were slightly different remember this is natural stone but the total length of segments was correct. The limit on length was weight and the shape of the raw stone block. One section they made a setout mistake and it was a nightmare to blend it out.

 

This may be of interest Home - Bamstone

0 Likes
Message 8 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Thanks to everyone for their help! I've tried both versions, but can't see any difference between them when using them. When I tried them on a polyline it seems to work perfectly well as intended, but I would prefer the lisp to also work with lines and arcs at the same time. I tried adding lines and arcs in the following code line (which I assume is where one specifies what sorts of objects are allowed to be selected:

(The bold text is my addition)

(setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC") (8 . "M-DEC---E1N")))
i -1
)

 

But that ended up giving a error message: Error: ActiveX Server returned the error: unknown name: "EXPLODE"

 

If yuo could help me with that issue I'd be grateful. Oh, and also, is it possible to sort the table so that the first row is for straight lines, and then the list of arc radius will be sorted from smallest to largest? As it is now, I believe the order is taken from in what order the lisp "finds" new a radius.

 

Message 9 of 21

hak_vz
Advisor
Advisor

@jakob.holmquistGRCUL 

Here is updated code that works with arcs, lines, and polylines.

If this works for you click on button ACCEPT SOLUTION. It marks final solution and helps in searching through all replies, and with "likes" helps solution poster in building its forum ranking.

 

 

(defun c:curbscount
	(/ *error* acdoc curved_list i to len m newtot olst rad ss str_segs_length table tot)
	;author hak_vz  
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;with ronjonp
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/593837
	;Posted at
	;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/looking-for-a-lsp-that-adds-the-total-length-of-lines-plines/td-p/10850094
	;Friday, December 31, 2021
	(defun *error* (msg)
		(if	(not (member msg '("Function cancelled" "quit / exit abort")))
			(princ (strcat "\nError: " msg))
		)
		(if	acdoc
			(vla-endundomark acdoc)
		)
		(princ)
	)
	(defun create_table_header
		(title lst_headers lst_column_widths / pt i column headers lst_column_widths)
		(setq pt (vlax-3d-point (getpoint "\nSelect table insertion point >")))
		(if	(and pt)
			(progn 
				(setq table 
					(vla-addtable
						(vla-get-modelspace acdoc)
						pt 2		; number of rows
						(length lst_headers) ; number of colums
						0.5		; cell height
						5		; cell  width
					)
					i	 0
				)
				(vla-settext table 0 0 title)
				(foreach column lst_headers
				(vla-settext table 1 i column)
				(vla-setcolumnwidth table i (nth i lst_column_widths))
				(setq i (+ i 1))
				)
			)
		)
		(vla-endundomark acdoc)
		(princ)
	)
	(defun table_add_row (table lst_data / i newrow)
		(cond 
			((not (vlax-erased-p table))
				(vla-put-regeneratetablesuppressed table :vlax-true)
				(setq newrow	(vla-get-rows table) i	0)
				(vla-insertrows table newrow 1 1)
				(vla-setrowheight table newrow 0.5)
				(foreach col lst_data (vla-settext table newrow i col) (setq i (+ i 1)))
				;(vla-put-RegenerateTableSuppressed table :vlax-false)
				(vla-recomputetableblock table :vlax-true)
			)
		)
		(princ)
	)
	(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
	(princ "\nSelect all curbs polylines in layer M-DEC---E1N >")
	(vla-endundomark acdoc)
	(vla-startundomark acdoc)
	(setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC") (8 . "M-DEC---E1N"))) i  -1)
	(setq str_segs_length 0)
	(setq curved_list (list))
	(while (< (setq i (1+ i)) (sslength ss))
		(setq to (vlax-ename->vla-object (ssname ss i)))
		(cond 
			((= (vlax-get to 'objectname) "AcDbLine")
				(setq str_segs_length (+ str_segs_length (vlax-get to 'length)))
			)
			((= (vlax-get to 'objectname) "AcDbArc")
				(setq rad (vlax-get to 'radius))
				(setq len (vlax-get to 'arclength))
				(cond 
					((and (setq m (assoc rad curved_list)))
						(setq tot (cadr m))
						(setq newtot (+ tot len))
						(setq curved_list (subst (list rad newtot) (assoc rad curved_list) curved_list))
					)
					(t (setq curved_list (cons (list rad len) curved_list)))
				)			
			)
			((= (vlax-get to 'objectname) "AcDbPolyline")
				(setq olst (vlax-invoke to 'explode))
				(foreach eo	olst
					(cond 
						((= (vlax-get eo 'objectname) "AcDbLine")
							(setq str_segs_length (+ str_segs_length (vlax-get eo 'length)))
						)
						((= (vlax-get eo 'objectname) "AcDbArc")
							(setq rad (vlax-get eo 'radius))
							(setq len (vlax-get eo 'arclength))
							(cond 
								((and (setq m (assoc rad curved_list)))
									(setq tot (cadr m))
									(setq newtot (+ tot len))
									(setq curved_list (subst (list rad newtot) (assoc rad curved_list) curved_list))
								)
								(t (setq curved_list (cons (list rad len) curved_list)))
							)
						)
					)
				)
				(mapcar 'vla-delete olst)
			)
		)
	)
	(create_table_header "Total lenghts" '("" "Radius" "Total length") '(5 5 5))
	(table_add_row table (list "Straight line" "-" (rtos str_segs_length 2 3)))
	(setq curved_list (vl-sort curved_list '(lambda (x y) (< (car x) (car y)))))
	(foreach ent curved_list
	(table_add_row table (list "Arc" (rtos (car ent) 2 1) (rtos (cadr ent) 2 3)))
	)
	(vla-endundomark acdoc)
	(princ)
)

 

 

 

 

 

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 10 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Hi! Thanks for your help! I've tried it on my test file and it works perfectly. However, when I tried it on a file from a real project I found out that 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, and indeed the lisp let me select them, but their lengths were not calculated, neither the straight or arc segments. I guess I could manually convert all 2d polylines to polylines before running this lisp, but since a software we use produce 2D polylines I would prefer if this lisp could handle those objects as well.

 

Another thing that I forgot to mention when specifying the lisp's functionality was how it should handle an arc with a large radius. So basically the manufacturers in my country can create curbstones with a radius up to 12 metres. Any curve larger than that is constructed by placing straight curbstones to artificially create a curve. So if the lisp could handle all arcs with radius larger than 12 as a straight line, it would be perfect! So in pseudo code it would basically be:

if (arc_radius > 12);

   treat_arc_as_straight_line;

   else;

   treat_arc_as_arc;

end if;

 

With these two additions to the lisp I can't imagine there being any more issues with it. I appreciate any efforts in helping me with this! 🙂

 

 

EDIT:

Sometimes the lisp creates a table with multiple rows for seemingly the same radius. I looked into it, and by making the lisp print the radius with many more decimals this seems to happen when two radius differ with a very small amount, for example a difference of 0.00000001 m, basically so small that the two arcs appear to have the same radius when selected in AutoCAD (selecting both arcs and viewing their radius in Properties will show the same radius with 3 decimals, and NOT *VARIES* as it should when the selected objects have different radius). So when the lisp is set up to print the arcs with one decimal the two arcs are rounded up to the same first decimal of course, but printed on two separate lines in the table. Is there a way to have the lisp compare if there is a negligable difference between arcs with different radius so that arcs with radius for example 2.501m are categorised in the same group as arcs with radius 2.49997m? Maybe have the radius rounded up to 2 decimals when deciding if two arcs should be on the same or different rows?

0 Likes
Message 11 of 21

hak_vz
Advisor
Advisor

@jakob.holmquistGRCUL 

Can you attach sample drawing that contains all requested elements to help me making tests. I will make code later today.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 12 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Absolutely! Here is a sample drawing. 

This file contains circles (from roundabouts), something I overlooked. Is it possible to add circles as well, so that their circumference is added to the total length of the group of arcs with matching radius?

0 Likes
Message 13 of 21

hak_vz
Advisor
Advisor

OK, I will add circles and make tests.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 14 of 21

hak_vz
Advisor
Advisor

@jakob.holmquistGRCUL 

Can you provide list or standard curbs radius values under 12 m.  

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 15 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Sure! Here is a list of standard radius available from curbstone manufacturers: 

0,5m / 0,6m / 0,75m / 1,0m / 1,5m / 2,0m / 3,0m / 4,5m / 6,0m / 7,5m / 10,0m / 12,0m

0 Likes
Message 16 of 21

hak_vz
Advisor
Advisor
Accepted solution

@jakob.holmquistGRCUL 

Test this code on your older project to check for possible errors.

I didn't added test to check if curb radius in a list of standard radius but that it will work OK. 

There may come an error with small radius 0.5 and 0.6.

I would suggest that you convert POLYLINE object to LWPOLYLINE.

Also, copy all entities in curbs layer M-Dec..... to separate location, explode all and check for result consistency.

 

(defun c:curbscount
	(/ *error* create_table_header table_add_row acdoc curved_list i to len m newtot olst rad ss str_segs_length table tot)
	;author hak_vz  
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;with ronjonp
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/593837
	;Posted at
	;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/looking-for-a-lsp-that-adds-the-total-length-of-lines-plines/td-p/10850094
	;Monday, January 03, 2022
	(defun *error* (msg)
		(if	(not (member msg '("Function cancelled" "quit / exit abort")))
			(princ (strcat "\nError: " msg))
		)
		(if	acdoc
			(vla-endundomark acdoc)
		)
		(princ)
	)
	(defun LM:roundm ( n m )(* m (atoi (rtos (/ n (float m)) 2 0))))
	(defun create_table_header
		(title lst_headers lst_column_widths / pt i column headers lst_column_widths)
		(setq pt (vlax-3d-point (getpoint "\nSelect table insertion point >")))
		(if	(and pt)
			(progn 
				(setq table 
					(vla-addtable
						(vla-get-modelspace acdoc)
						pt 2		; number of rows
						(length lst_headers) ; number of colums
						0.5		; cell height
						5		; cell  width
					)
					i	 0
				)
				(vla-settext table 0 0 title)
				(foreach column lst_headers
				(vla-settext table 1 i column)
				(vla-setcolumnwidth table i (nth i lst_column_widths))
				(setq i (+ i 1))
				)
			)
		)
		(vla-endundomark acdoc)
		(princ)
	)
	(defun table_add_row (table lst_data / i newrow)
		(cond 
			((not (vlax-erased-p table))
				(vla-put-regeneratetablesuppressed table :vlax-true)
				(setq newrow	(vla-get-rows table) i	0)
				(vla-insertrows table newrow 1 1)
				(vla-setrowheight table newrow 0.5)
				(foreach col lst_data (vla-settext table newrow i col) (setq i (+ i 1)))
				;(vla-put-RegenerateTableSuppressed table :vlax-false)
				(vla-recomputetableblock table :vlax-true)
			)
		)
		(princ)
	)
	(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
	(princ "\nSelect all curbs polylines in layer M-DEC---E1N >")
	(vla-endundomark acdoc)
	(vla-startundomark acdoc)
	(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE,ARC,CIRCLE") (8 . "M-DEC---E1N"))) i  -1)
	(setq str_segs_length 0)
	(setq sum_of_all 0)
	(setq curved_list (list))
	(while (< (setq i (1+ i)) (sslength ss))
		(setq to (vlax-ename->vla-object (ssname ss i)))
		(cond 
			((= (vlax-get to 'objectname) "AcDbLine")
				(setq str_segs_length (+ str_segs_length (vlax-get to 'length))
                      sum_of_all (+  sum_of_all(vlax-get to 'length))
				)
			)
			((or (= (vlax-get to 'objectname) "AcDbArc")(= (vlax-get to 'objectname) "AcDbCircle"))
				(if 
					(= (vlax-get to 'objectname) "AcDbArc")
					(setq 
						rad (LM:roundm (vlax-get to 'radius) 0.05)
						len (vlax-get to 'arclength)
					)
				)
				(if 
					(= (vlax-get to 'objectname) "AcDbCircle")
					(setq 
						rad (LM:roundm (vlax-get to 'radius) 0.05)
						len (vlax-get to 'circumference )
					)
				)
				(if 
					(<= rad 12.0)
						(cond 
							((and (setq m (assoc rad curved_list)))
								(setq tot (cadr m))
								(setq newtot (+ tot len))
								(setq curved_list (subst (list rad newtot) (assoc rad curved_list) curved_list))
								
							)
							(t (setq curved_list (cons (list rad len) curved_list)))
						)			
						(setq str_segs_length (+ str_segs_length len)) 
				)
				(setq sum_of_all (+  sum_of_all len))
			)
			((or (= (vlax-get to 'objectname) "AcDbPolyline")(= (vlax-get to 'objectname) "AcDb2dPolyline"))
				(setq olst (vlax-invoke to 'explode))
				(foreach eo	olst
					(cond 
						((= (vlax-get eo 'objectname) "AcDbLine")
							(setq str_segs_length (+ str_segs_length (vlax-get eo 'length))
								  sum_of_all (+  sum_of_all(vlax-get eo 'length))
							)
						)
						((= (vlax-get eo 'objectname) "AcDbArc")
							(if 
								(= (vlax-get eo 'objectname) "AcDbArc")
								(setq 
									rad (LM:roundm (vlax-get eo 'radius) 0.05)
									len (vlax-get eo 'arclength)
								)
							)
							(if 
								(<= rad 12.0)
									(cond 
										((and (setq m (assoc rad curved_list)))
											(setq tot (cadr m))
											(setq newtot (+ tot len))
											(setq curved_list (subst (list rad newtot) (assoc rad curved_list) curved_list))
										)
										(t (setq curved_list (cons (list rad len) curved_list)))
									)			
									(setq str_segs_length (+ str_segs_length len)) 
							)
							(setq sum_of_all (+  sum_of_all len))	
						)
					)
				)
				(mapcar 'vla-delete olst)
			)
		)
	)
	(create_table_header "Total lenghts" '("" "Radius" "Total length") '(5 5 5))
	(table_add_row table (list "Straight line" "-" (rtos str_segs_length 2 3)))
	(setq curved_list (vl-sort curved_list '(lambda (x y) (< (car x) (car y)))))
	(foreach ent curved_list
	(table_add_row table (list "Arc" (car ent) (rtos (cadr ent) 2 3)))
	)
	(table_add_row table (list "" "Total:" (rtos sum_of_all 2 3)))
	(vla-endundomark acdoc)
)

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 17 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

Wow, thank you so much for your effort! I have tried it in several files and have not found any errors when comparing polylines/arcs/lines/circles to the same objects but the polylines are exploded. So I think this lisp works as intended, and is exactly what I asked for. 😀 Well done, and thanks again!  

 

One question out of curiosity, I have noticed that the table looks kind of inconsistent regarding text size and fonts, and it is due to my default table style. I can change the table style so that the table looks much better, but is there a way to override the current table style when creating the table from the lisp? 

 

Picture of how it looks when I fixed the table style:

jakobholmquistGRCUL_2-1641222427287.png

 

Picture of how it looks without editing table style:

jakobholmquistGRCUL_1-1641222387068.png

 

 

0 Likes
Message 18 of 21

hak_vz
Advisor
Advisor

In attachment is a updated code with function CreateTableStyle and some changes at the bottom of the code.

Check the differences to final code and you will see how it works. Try to read the code and find out how it works.

This can be a good lesson in learning autolisp / visual lisp. Sorry but subject is to complex to try to describe it in few sentences. Name of vl functions for work with tables are descriptive enough so you can grasp it relatively easy.

Change values in accordance to your preferences.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Message 19 of 21

Sea-Haven
Mentor
Mentor

Hak_vz I could not see with the 12m plus kerbs are you implying they are made up of straights / facets so what length is the straight kerb stone then would have a remainder piece. Say 1m lengths  should be allowed for.

 

eg 12m rad 45deg bend is 10x 1m lengths plus a 0.422m length. I know with Bamstone they would as a cheaper alternative just supply a "TOTAL" length of kerbs but they would be different lengths as they are cut from natural stone.

0 Likes
Message 20 of 21

jakob.holmquistGRCUL
Enthusiast
Enthusiast

With your last update of the lisp I have been able to adjust the table's appearance to my liking, so now the lisp is perfect, thanks again for your help! 🙂 I have learned a bit of code in the process as well which is fun!