looking for LISP to draw lines/plines with measurement of each segment and total length

looking for LISP to draw lines/plines with measurement of each segment and total length

julie.walker2
Enthusiast Enthusiast
817 Views
6 Replies
Message 1 of 7

looking for LISP to draw lines/plines with measurement of each segment and total length

julie.walker2
Enthusiast
Enthusiast

I'm looking for a LISP (or maybe an existing AutoCAD command I'm missing) to draw lines or pline on its own layer that will remain in place, and show measurement of each segment and total length of all segments. I need to show wire lengths between devices as well as length of the entire run of wire, and we'd probably use it for pipe measurements too for an air detector. Dimensions don't work as there are too many steps, they won't go off in any direction like wire can, and if there's a cumulative total I'm not aware of how to get it without running a separate dimension alongside the segments. We've already got a way to approximate the drops down to the devices, etc. we just need a general quick and dirty length between devices. I've attached a pic of what I'm hoping the result would be, just a quick click device to device to device and esc or enter to finish. Does anyone know of something that exists already to do this?

dimlines.png

This is my work ID, since now your ID is associated with your software.
My other ID is Julesagainn.
AutoCAD user since 1988.
0 Likes
818 Views
6 Replies
Replies (6)
Message 2 of 7

Sea-Haven
Mentor
Mentor

There is plenty of label pline segments out there. Do a google I would look here Kent Cooper has some good ones. So if your brown lines are plines then the length is a property which you can get. I would add an extra label like "Run-1" then you can do a table of all the lengths. 

 

The best way to do this is with a sample dwg, does the brown pline exist or is it to be drawn as well.

0 Likes
Message 3 of 7

MrJSmith
Advocate
Advocate

@julie.walker2 See if this works for you. I assumed the drawing was already in feet units. If it is in inches, you will have to divide the number by 12. I also assumed the current layer you are on is the layer you wanted the lines/text to be on.

 

Let me know if you have any issues. 

 

(defun c:LineDist ( / pt len lenList midPt text endPt MS:roundm MS:roundto MS:numString MS:maskMText MS:lineDist MS:getMidpointOfLine MS:findpoints MS:segfinder) 
	;##########ERROR FUNCTION##########
	(defun *error* (msg)
		(if (not (member msg '("Function cancelled" "quit / exit abort" "bad argument type: numberp: nil")))
			(princ (strcat "\nError: " msg))
			(if lenList (progn (setq pt (getpoint "Pick location for total length")) (MS:maskMText pt (strcat (MS:numString (MS:roundto (apply '+ lenList) 1)) "'"))(setq MS:flag nil)(princ "\n")(princ)))
		)
	)
	
	;##########HELPER FUNCTIONS##########
	(defun MS:roundm ( n m ) (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) ) ;; Rounds 'n' to the nearest multiple of 'm'
	(defun MS:roundto ( n p ) (MS:roundm n (expt 10.0 (- p)))) ;; Rounds 'n' to 'p' decimal places
	
	(defun MS:numString (val / tp precision check)
		(setq tp (type val)) ;value type
		(cond
			((= tp 'STR)
				val
			)
			((= tp 'INT)
				(itoa val)
			)
			((= tp 'REAL)
				(setq check (rtos val 2 13)) ;at 15 or higher, start getting distoration in the form of .009999999999999 for .01
				(setq precision (strlen (vl-string-right-trim "0" (substr check (+ (vl-string-search "." check) 2)))))
				;(debug "Precision " precision)
				(rtos val 2 precision)
			)
		)
		
	)
	
	(defun MS:maskMText (pt text)
		(entmake (list
			(cons 0 "MTEXT")
			(cons 100 "AcDbEntity")
			(cons 100 "AcDbMText")
			(cons 7 "Standard") ;Text Type
			;(cons 8 layerName) ;Change for layer name
			(cons 71 5)
			(cons 72 5)
			(cons 73 1)
			(cons 10 pt)
			(cons 11 (list 1.0 0.0 0.0))
			(cons 50 0)
			(cons 41 0)
			(cons 40 (getvar "TEXTSIZE"))
			(cons 44 1.0)
			(cons 1 text)
			'(90 . 3) ;Masking
			'(63 . 256) ;Background masking color
			'(45 . 1.3) ;Change to increase/decrease masking size
			'(441 . 0) ;End masking
	   ))
	)
	(defun MS:lineDist (ent / pointlist dist) ;Returns the distance of a line polyline
		(setq pointlist (MS:segfinder ent))
		(setq dist 0.0)
		(foreach seg pointlist
			(setq dist (+ (distance (car seg) (cadr seg)) dist))
		)
		dist
	)
	
	(defun MS:getMidpointOfLine (object) ;Entity or SS, returns midpoint of a line
		(setq pt (MS:findpoints (entget object)))
		(mapcar '/ (mapcar '+ (car pt) (cadr pt)) '(2 2 2))
	)
	
	(defun MS:findpoints ( elist / pointlist elistName)
		(cond
			((= (cdr (assoc 0 elist)) "LWPOLYLINE") ;checks for polyline because elevation is separate
				(foreach inf elist
					(if (= (car inf) 10)
						(setq pointlist (append pointlist (list (append (cdr inf) (list (cdr (assoc 38 elist)))))))
					)
				)
			)
			((= (cdr (assoc 0 elist)) "POLYLINE")
				(setq elistName (cdr (assoc -1 elist)))
				(while (and (setq elistName (entnext elistName)) (not (= (cdr (assoc 0 elist)) "SEQEND")))
					(setq elist (entget elistName))
					(if (cdr (assoc 10 elist))
						(setq pointlist (append pointlist (list (cdr (assoc 10 elist)))))
					)
				)
			)
			(t
				(foreach inf elist
					(if (= (cdr (assoc 0 elist)) "MULTILEADER")
						(if (= (car inf) 10)
							(setq pointlist (append pointlist (list (cdr inf))))
						)
						(progn 
							(if (= (car inf) 10)
								(setq pointlist (append pointlist (list (cdr inf))))
							)
							(if (= (car inf) 11)
								(setq pointlist (append pointlist (list (cdr inf))))
							)
						)
					)
				)
			)
		)
		pointlist
	) ;End findpoints

	;Finds the coordinate points of a line and returns a list of 2 point line segment lists. 
	(defun MS:segfinder (entname / p1 p2 points pointlist count LastPoint entityValuebyCode) ;Takes a line or polyline and returns a list of points that make it up
		(defun entityValuebyCode (entity code)
			(cdr (assoc code (entget entity)))
		)
		(cond 
			((wcmatch (entityValueByCode entname 0) "*POLYLINE")
				(setq points (MS:findpoints (entget entname)))
				(setq pointlist nil)
				(setq count 0)
				(foreach point points ;Loops through all the segments
					;If first point, do nothing. Starts with second point.
					(if (not (= count 0))
						(progn
							(setq 
								p1 (nth (- count 1) points) ;Set to previous point
								p2 point ;set to current point
							)
							(setq pointlist (append pointlist (list (list p1 p2))))
							(setq LastPoint p2) ;Keep track of last point
						)
					) ;end if
					(setq count (+ count 1))
				) ;end foreach
				;Check if entity is a closed object
				(if (or (= (entityValueByCode entname 70) 1) (= (entityValueByCode entname 70) 129))
					;Add closing segment to list
					(setq pointlist (append pointlist (list (list (nth 0 points) Lastpoint))))
				)
			)
			((= (entityValueByCode entname 0) "LINE")
				(setq pointlist (list (list (entityValueByCode entname 10) (entityValueByCode entname 11))))
			)
		)
		;Output
		pointlist
		
	) ;End segFinder
	
	(defun LM:sendkeys ( str / wsh rtn )
		(if (setq wsh (vlax-create-object "wscript.shell"))
			(progn
				(setq rtn (vl-catch-all-apply 'vlax-invoke (list wsh 'sendkeys str)))
				(vlax-release-object wsh)
				rtn
			)
		)
	)
	
	;############START MAIN#############
	(while 1
		(if (not MS:flag) (setq MS:flag 1) (progn (setq MS:flag nil)(LM:sendkeys "{ESC}" )))
		(if endPt
			(command "pline" endPt pause "") ;Start line at last line endpoint
			(command "pline" pause pause "")
		)
		(if 
			(and
				(setq endPt (car (reverse (car (MS:segfinder (entlast)))))) ;Get endpoint of line and save to use in future
				(setq len (MS:lineDist (entlast))) ;Get the length of line
				(setq midPt (MS:getMidpointOfLine (entlast))) ;Get midpoint of line
				(setq text (strcat (MS:numString (MS:roundto len 1)) "'")) ;Create the text of the line. Calling units to ft and rounding it to the first decimal position
				(MS:maskMText  midPt text)
				(setq lenList (cons len lenList))
			)
			(setq MS:flag nil)
		)
	)
)

 

0 Likes
Message 4 of 7

paullimapa
Mentor
Mentor

there's this one posted awhile back which will labelled the length of an already drawn pline:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/pline-segment-length-labels/m-p/1015... 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 5 of 7

Kent1Cooper
Consultant
Consultant

For the segments, try DimPolySeg.lsp with its DPS command, >here<.  It did this instantaneously:

Kent1Cooper_0-1702041676232.png

Note the requirements for the current Dimension Style in the comments at the top, except you will want the text to be horizontal.  Set your rounding level, zero suppression [I think I got that as in your image], etc. as desired.

 

A benefit of using Dimensions is that [in this routine linear ones] they will update in both position and text content if you Stretch the situation.

 

As for the overall length, something can be added if it otherwise does what you want.  Should it always be at the start/end vertex?  Always at the bottom-most vertex?  Etc.

Kent Cooper, AIA
0 Likes
Message 6 of 7

julie.walker2
Enthusiast
Enthusiast

Thank you so much everyone! I'll try all these suggestions over the next week and respond back as I can.

Yes I Googled a lot before posting. The goal is to get a rough estimate of wire length between devices, and the total run length, to calculate voltage drop, rounding up to the nearest foot to keep a safe margin of error. They don't always end up at the origin point, for class B it's just a wire run from panel across devices and ending out on the floor somewhere. I should have showed both types and included the DWG file, sorry about that. 
The dimension update is a nice feature, but inserting them just takes too many clicks. However I'll give that a try too.
Thanks again,

Julie

This is my work ID, since now your ID is associated with your software.
My other ID is Julesagainn.
AutoCAD user since 1988.
0 Likes
Message 7 of 7

Kent1Cooper
Consultant
Consultant

@julie.walker2 wrote:

.... 

The dimension update is a nice feature, but inserting them just takes too many clicks. However I'll give that a try too.
....


[If you're referring to my Message, the linked routine does them all for you with just one click selecting the Polyline.]

Kent Cooper, AIA
0 Likes