LINE LENGTH TO EXCEL

[CADSURAY]

Hi Forum..!

 

I am looking for a LISP that would assign a identity code to all selected lines and also mention the lines length in adjacent cell and can be exported to excel.

 

Please Help..

 

Best Regards.

CADSURYA

[BIGAL]

Did you google, say "Make table length of lines Autocad Lisp". Lots of examples.

 

Export table to Excel. You can be lucky. See attached.

table to excel.lsp

 

 

[CADSURAY]

Sorry for the delayed response.

 

Yes Sir Bigal I did google and found some Lisps.

 

But they tend to give the total length of lines in a table.

 

Attached two Lisps with this Post. 

 

1. Getlengt h By Sir Tharwat - The selection of all lines is what i need like in this code - but I need individual line lengths and it would be great if each line is assigned with a identity Code text on the line itself

2. PkLength Author Unkown - this code works good with Indvidual lines but one has to select one line at a time.

 

pklength.vlx GetLengths.VLX

[Tsuky]

@CADSURAY

Quote

I am looking for a LISP that would assign a identity code to all selected lines and also mention the lines length in adjacent cell and can be exported to excel.

 

Why not use the Autocad handle instead of creating a new one?
At least it could be used for a selection in Autocad
Example if you have '"A3F4" in a 'handle' cell you could do this to find the graphic entity in the drawing.

(sssetfirst nil (ssadd (handent "A3F4") (ssadd)))

Code for export length to excel

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

 

[CADSURAY]

WAO..! Tsuky..!

 

JUST THE THING...

 

Thank you So Much.

 

Maybe i am asking too much,.. can this feature be added where in leaders to Indvidual lines with the Handle mentioned appears in the drawing automagicaly ?

 

 

 

[Tsuky]

@CADSURAY

Quote

Maybe i am asking too much,.. can this feature be added where in leaders to Indvidual lines with the Handle mentioned appears in the drawing automagicaly ?

 

This?

(vl-load-com)
(defun make_mlead (pt obj / ptlst arr nw_obj)
  (setq
    ptlst (append pt (polar pt o_lead d_lead))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring nw_obj 
    (strcat
      "{\\fArial|b0|i0|c0|p34;\""
      "%<\\AcObjProp Object(%<\\_ObjId "
      (itoa (vla-get-ObjectID obj))
      ">%).Handle \\f \"%lu2%pr2\">%\"}"
    )
  )
  (vla-put-layer nw_obj "Handle Entities")
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (vla-put-TextBottomAttachmentType nw_obj 0)
  (vla-put-TextRightAttachmentType nw_obj 1)
  (vla-put-TextLeftAttachmentType nw_obj 1)
  (vla-put-TextJustify nw_obj 1)
  (vla-put-TextDirection nw_obj 5)
  (vla-put-TextBackgroundFill nw_obj 0)
  (vla-put-TextFrameDisplay nw_obj 1)
  (vla-update nw_obj)
)
(defun c:length_curve2xls ( / AcDoc Space d_lead o_lead ss factor xls wks lin n obj pt_lead)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    d_lead (* 7.0 (getvar "TEXTSIZE"))
    o_lead (* pi 0.25)
  )
  (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>")
          )
        )
      )
      (cond
        ((null (tblsearch "LAYER" "Handle Entities"))
          (vlax-put (vla-add (vla-get-layers AcDoc) "Handle Entities") 'color 64)
        )
      )
      (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))))
          pt_lead (vlax-curve-getStartPoint obj)
        )
        (make_mlead pt_lead obj)
        (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))
      )
      (vla-regen AcDoc acactiveviewport)
      (mapcar 'vlax-release-object (list wks xls))
      (gc)(gc)
      (vla-endundomark AcDoc)
    )
  )
  (prin1)
)

 

[CADSURAY]

Million Thanks to you Tsuky.!

 

Exactly Spot on...! 

 

Had to do a few seconds of tweaking and rearranging.

Thats completely fine, as the case may be one has to do it is the best way suitable to the drawing, this lisp is just great.!

 

 

[Momi]

Hi @Tsuky

I've several Lisps for lengths and areas But I want the Similar thing as @CADSURAY wanted.

When I Click On Polyline It will change the color and send value to Excel. Currently I'm using "pklength.vlx"Lisp, It's working Perfect but not changing the color of selected polylines.