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)
)