Get the length of the polyline in table along with selected text

Get the length of the polyline in table along with selected text

Prashanthr
Enthusiast Enthusiast
324件の閲覧回数
2件の返信
メッセージ1/3

Get the length of the polyline in table along with selected text

Prashanthr
Enthusiast
Enthusiast

Hello,

 

I'm looking for a lisp which would provide me the length of the polyline along with the text selected in the table format to calculate the cable length.

I have attached a sample drawing for your reference. I want to select the polyline and then select the text and both should be added to the table.

Thanks in advance for your help.

0 件のいいね
解決済み
325件の閲覧回数
2件の返信
返信 (2)
メッセージ2/3

Sea-Haven
Mentor
Mentor
解決済み

Give this a try. 

(defun c:nlen ( /  colwidth CreateTableStyle len numcolumns numrows obj objtable row rowheight sp txt txtent txtht vgms)

(defun CreateTableStyle (txtht / dicts dictobj key class custobj )
    
;; Get the Dictionaries collection and the TableStyle dictionary
(setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object))))
(setq dictObj (vla-Item dicts "acad_tablestyle"))

(vlax-for dname dictobj
  (if (=  (vla-get-name dname) "T1-5x2" ) ; does it exist
  (princ)
    (progn
    (setq key "T1.5x2" class "AcDbTableStyle")
    (setq custObj (vla-AddObject dictObj key class))
    
    ;; Set the name and description for the style
    (vla-put-Name custObj "T1-5x2")
    (vla-put-Description custObj "T1-5x2 custom table style")
    
    ;; Sets the bit flag value for the style
    (vla-put-BitFlags custObj 1)
    
    ;; Sets the direction of the table, top to bottom or bottom to top
    (vla-put-FlowDirection custObj acTableTopToBottom)
    
    ;; Sets the horizontal margin for the table cells
    (vla-put-HorzCellMargin custObj (/ txtht 2.0))
    
    ;; Sets the vertical margin for the table cells
    (vla-put-VertCellMargin custObj (/ txtht 2.0) )
    
    ;; Set the alignment for the Data, Header, and Title rows
    (vla-SetAlignment custObj acDataRow  acMiddleCenter)
    (vla-SetAlignment custObj acHeaderRow acMiddleCenter)
    (vla-SetAlignment custObj acTitleRow acMiddleCenter)
    
    ;; Set the text height for the Title, Header and Data rows
    (vla-SetTextHeight custObj acDataRow txtht)
    (vla-SetTextHeight custObj acHeaderRow txtht)
    (vla-SetTextHeight custObj acTitleRow txtht)
    
    ;; Set the text height and style for the Title row
    (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")
    )
  )
)

(setvar 'ctablestyle "T1-5x2")
)

; starts here

(setq txtht 1.5)

(CreateTableStyle txtht)

(setq sp (vlax-3d-point (getpoint "\nPick point for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 3)
(setq numcolumns 2)
(setq rowheight (* 2.0 txtht))
(setq colwidth 15)

(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))

(vla-setalignment objTable acTitleRow  acMiddleCenter)
(vla-setalignment objTable acHeaderRow acMiddleCenter)
(vla-setalignment objTable acDataRow   acMiddleCenter)
(setq objtable (vlax-ename->vla-object (entlast)))

(setq row 2)

(vla-settext objtable 0 0 "Title")
(vla-settext objtable 1 0 "Name")
(vla-settext objtable 1 1 "Length")
(while (setq txtent (car (entsel "\nPick text enter to exit ")))
  (setq txt (cdr (assoc 1 (entget txtent))))
  (setq obj (vlax-ename->vla-object (car (entsel "\nPick pline object "))))
  (setq len (rtos (vlax-get obj 'length) 4))
  (vla-settext objtable row 0  txt)
  (vla-settext objtable row 1 len)
  (vla-insertrows objtable (1+ row) (* txtht 2) 1)
  (setq row (1+ row))
)

(princ)
)
(c:nlen)
メッセージ3/3

Prashanthr
Enthusiast
Enthusiast

Hello @Sea-Haven 

 

Good Morning!

 

Fantastic! This works flawlessly—right on point!

I truly appreciate it. Thank you!

0 件のいいね