Extract Polyline Lengths with Associated Text Labels in AutoCAD

[Tamim]

I have many polylines, and each one has a text label placed nearby (for example: “L-01” near a polyline with a length of 1.25 ft).

I want a program that, once I select the polyline and its nearby text, automatically gives the result based on the text and the polyline’s length.

I’ve attached the CAD file here ,please share the suitable program for this.

Line Length Sample.dwg

[Danielm103]

here's something in Python, if you can find anything in lisp

 

[Tsuky]

You can use this to obtain for onely one sheet in excel...

; by patrick_35
; mods by beekeecz and bonuscad
;(sssetfirst nil (ssadd (handent "2F") (ssadd)))
(vl-load-com)
(defun c:length_curve2xls ( / AcDoc Space ss factor xls wks lin n obj)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (princ "\nSelect objects")
  (cond
    ((setq ss
        (ssget
          (list
            '(0 . "*POLYLINE,LINE,ARC,CIRCLE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
            '(-4 . "<NOT")
              '(-4 . "&")
              '(70 . 112)
            '(-4 . "NOT>")
          )
        )
      )
      (initget 2)
      (setq factor (getreal "\nMultiplicative factor to apply to lengths? <1>: "))
      (if (not factor) (setq factor 1.0))
      (vla-startundomark AcDoc)
      (setq xls (vlax-get-or-create-object "Excel.Application"))
      (or (setq wks (vlax-get xls 'ActiveSheet))
        (vlax-invoke (vlax-get xls 'workbooks) 'Add)
      )
      (setq
        wks (vlax-get xls 'ActiveSheet)
        lin 2
      )
      (vlax-put xls 'Visible :vlax-true)
      (vlax-put (vlax-get-property wks 'range "A1") 'value "Handle")
      (vlax-put (vlax-get-property wks 'range "B1") 'value "Length")
      (repeat (setq n (sslength ss))
        (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
        (vlax-put
          (vlax-get-property wks 'range (strcat "A" (itoa lin)))
          'value
          (strcat "\"" (vlax-get-property obj 'Handle) "\"")
        )
        (vlax-put
          (vlax-get-property wks 'range (strcat "B" (itoa lin)))
          'value
          (* factor
            (vlax-get-property obj
              (cond
                ((eq (vla-get-ObjectName obj) "AcDbArc") "ArcLength")
                ((eq (vla-get-ObjectName obj) "AcDbCircle") "Circumference")
                (T "Length")
              )
            )
          )
        )
        (setq lin (1+ lin))
      )
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
      (vla-endundomark AcDoc)
    )
  )
  (prin1)
)

An if you want to re-labeling your polylines with a field for link with table.

(vl-load-com)
(defun c:Label_Handle ( / ss htx AcDoc Space n ename obj alpha nw_obj)
  (princ "\nSelect LWPolylines.")
  (while
    (null
      (setq ss
        (ssget
          (list
            '(0 . "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
    (princ "\nAren't LWPolylines!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nGive the height of the text <" (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)
    )
  )
  (vla-startundomark AcDoc)
  (repeat (setq n (sslength ss))
    (setq
      ename (ssname ss (setq n (1- n)))
      obj (vlax-ename->vla-object ename)
      alpha 0.0
      nw_obj
      (vla-addMtext Space
        (vlax-3d-point (vlax-curve-GetEndPoint obj))
        0.0
        (strcat
          "{\\fArial|b0|i0|c0|p34;"
          "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
          (itoa (vla-get-ObjectID obj))
          ">%).Handle \\f \"%tc1\">%"
        )
      )
    )
    (mapcar
      '(lambda (pr val)
        (vlax-put nw_obj pr val)
      )
      (list 'AttachmentPoint 'Height 'DrawingDirection 'Layer 'Rotation)
      (list 5 (getvar "TEXTSIZE") 5 (getvar "CLAYER") alpha)
    )
  )
  (vla-endundomark AcDoc)
  (prin1)
)

 

[Saxlle]

@Tamim

 

Try this code and see if it helpful:

 

(prompt "\nTo run a LISP type: LPL")
(princ)

(defun c:LPL ( / ss len circ txt_height lst i minPt maxPt midPt circle inc ang num ptlist k pt ssn pl_len ins_pt)
  
  (prompt "\nSelect all TEXT entities:\n")
  
  (setq ss (ssget (list (cons 0 "TEXT")))
	len (sslength ss)
	circ 0.05 ;; radius of the circle can be changeable
	txt_height 0.01 ;; mtext height can be changeable
	lst (list)
	i 0
	)
  
  (while (< i len)
    
    (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt)
    
    (setq minPt (vlax-safearray->list minPt)
	  maxPt (vlax-safearray->list maxPt)
	  midPt (mapcar '* (mapcar '+ minPt maxPt) (list 0.5 0.5))
	  )
    
    (entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle") (cons 8 (getvar 'clayer)) (cons 10 midpt) (cons 40 circ)))
    
    (setq circle (entlast)
	  inc 0.25
	  ang 0
	  num (fix (/ (* pi 2) inc))
	  ptlist (list)
	  k 0
	  )
    
    (repeat num
      
      (setq pt (polar midPt ang circ)
	    ptlist (append (list pt) ptlist)
	    ang (+ ang inc)
	    )
      )
    
    (setq ssn (ssget "_F" ptlist (list (cons 0 "LWPOLYLINE")))
	  pl_len (getpropertyvalue (ssname ssn k) "Length")
	  )
    
    (entdel circle)
    
    (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) "\t  " (rtos pl_len 2 3) "\\P") lst)
	  i (1+ i)
	  )
    
    )
  
  (setq lst (vl-sort lst (function (lambda (x e) (< (atoi (substr (car x) 3 (strlen (car x)))) (atoi (substr (car e) 3 (strlen (car e))))))))
	lst (cons (list "\\fArial|b0|i0|c0|p34;S.No\tLength Ft\\P") lst)
	ins_pt (getpoint "\nPick the insertation point:")
	)
  
  (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 8 (getvar 'clayer)) (cons 10 ins_pt) (cons 40 txt_height) (cons 72 1)
		 (cons 1 (apply 'strcat (mapcar '(lambda (x) (apply 'strcat x)) lst)))))
  
  (prompt "\nThe labels and the length of the polylines were added as MTEXT!")
  (princ)
  
  )

 

Also, you can see the short video example of how it works.

 

 

Best regards.