Jump to content

Creating a table with the area and length of selected polylines

veteranus

By veteranus
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

veteranus Contributor

veteranus

Posted
Posted

Hello,

 

Can I write to all my selected poyline, lines, rectangles or anything total lenght and area to a table with selected layer name.

 

image.thumb.png.92e5bf5d1b2c9a58ba9fe1ea284a69ac.png

Example.dwg

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Try this, your lucky have code that sort of matches.

  

; make simple table of lines and plines
; by Alan H May 2024


(defun CreateTableStyle ( / 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"))
(setq txtht 0.07)

(vlax-for dname dictobj
  (if (=  (vla-get-name dname) "Veteranus" ) ; does it exist
   (setq Veteranus "No")
  )
)

(if (= Veteranus "No")
(progn

;; Create a custom table style
(setq key "Veteranus" class "AcDbTableStyle")
(setq custObj (vla-AddObject dictObj key class))

;; Set the name and description for the style
(vla-put-Name custObj "Veteranus")
(vla-put-Description custObj "Veteranus 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 0.1))

;; Sets the vertical margin for the table cells
(vla-put-VertCellMargin custObj (* txtht 0.2))

;; Set the alignment for the Data, Header, and Title rows
(vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)

;; Set the text height for the Title, Header and Data rows
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))

;; Set the text height and style for the Title row
(vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")

; (vla-put-regeneratetablesuppressed custobj :vlax-false)
)
)
)

(defun c:wow ( / sp vgms numrows numcolumns rowheight colwidth objtable x ss obj lay len area)

(createtablestyle)

(setvar 'ctablestyle "Veteranus")

(setq sp (vlax-3d-point (getpoint "pick a point for table")))

(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

(setq numrows 3)
(setq numcolumns 3)
(setq rowheight 0.1)
(setq colwidth 0.8)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "BBQ")
(vla-settext objtable 1 0 "Layername") 
(vla-settext objtable 1 1 "Tot Area (m2)") 
(vla-settext objtable 1 2 "Tot. Length (m)")

(command "_zoom" "e")

(setq ss (ssget '((0 . "Line,Lwpolyline"))))
(if (= ss nil)
(progn (alert "No lines or plines chosen\n\n will exit now")(exit))
)

(setq numrows 2)
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(if (= (vlax-get obj 'objectname) "AcdbLINE")
(progn
(setq lay (vlax-get obj 'layer))
(setq parea "0.0")
(setq len (rtos (vlax-get obj 'length) 2 2))
)
(progn
(setq lay (vlax-get obj 'layer))
(setq parea (rtos (vlax-get obj 'area) 2 2))
(if (= parea "0")(setq parea "0.0"))
(setq len (rtos (vlax-get obj 'length) 2 2))
)
)
(vla-InsertRows Objtable  numrows 0.1 1)
(vla-settext objtable numrows 0 lay)
(vla-settext objtable numrows 1 pArea)
(vla-settext objtable numrows 2 Len)
(setq numrows (1+ numrows))

)
(princ)
)
(c:wow)

 

Link to comment
Share on other sites
veteranus Contributor

veteranus

Posted
  • Author
Posted (edited)
4 hours ago, BIGAL said:

Try this, your lucky have code that sort of matches.

  

; make simple table of lines and plines
; by Alan H May 2024


(defun CreateTableStyle ( / 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"))
(setq txtht 0.07)

(vlax-for dname dictobj
  (if (=  (vla-get-name dname) "Veteranus" ) ; does it exist
   (setq Veteranus "No")
  )
)

(if (= Veteranus "No")
(progn

;; Create a custom table style
(setq key "Veteranus" class "AcDbTableStyle")
(setq custObj (vla-AddObject dictObj key class))

;; Set the name and description for the style
(vla-put-Name custObj "Veteranus")
(vla-put-Description custObj "Veteranus 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 0.1))

;; Sets the vertical margin for the table cells
(vla-put-VertCellMargin custObj (* txtht 0.2))

;; Set the alignment for the Data, Header, and Title rows
(vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter)

;; Set the text height for the Title, Header and Data rows
(vla-SetTextHeight custObj acDataRow txtht)
(vla-SetTextHeight custObj acHeaderRow (* txtht 1.2))
(vla-SetTextHeight custObj acTitleRow (* txtht 1.5))

;; Set the text height and style for the Title row
(vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard")

; (vla-put-regeneratetablesuppressed custobj :vlax-false)
)
)
)

(defun c:wow ( / sp vgms numrows numcolumns rowheight colwidth objtable x ss obj lay len area)

(createtablestyle)

(setvar 'ctablestyle "Veteranus")

(setq sp (vlax-3d-point (getpoint "pick a point for table")))

(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

(setq numrows 3)
(setq numcolumns 3)
(setq rowheight 0.1)
(setq colwidth 0.8)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "BBQ")
(vla-settext objtable 1 0 "Layername") 
(vla-settext objtable 1 1 "Tot Area (m2)") 
(vla-settext objtable 1 2 "Tot. Length (m)")

(command "_zoom" "e")

(setq ss (ssget '((0 . "Line,Lwpolyline"))))
(if (= ss nil)
(progn (alert "No lines or plines chosen\n\n will exit now")(exit))
)

(setq numrows 2)
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(if (= (vlax-get obj 'objectname) "AcdbLINE")
(progn
(setq lay (vlax-get obj 'layer))
(setq parea "0.0")
(setq len (rtos (vlax-get obj 'length) 2 2))
)
(progn
(setq lay (vlax-get obj 'layer))
(setq parea (rtos (vlax-get obj 'area) 2 2))
(if (= parea "0")(setq parea "0.0"))
(setq len (rtos (vlax-get obj 'length) 2 2))
)
)
(vla-InsertRows Objtable  numrows 0.1 1)
(vla-settext objtable numrows 0 lay)
(vla-settext objtable numrows 1 pArea)
(vla-settext objtable numrows 2 Len)
(setq numrows (1+ numrows))

)
(princ)
)
(c:wow)

 

 

Hello Bigal. Thanks for reply. I m getting this error and I have zero knowagle about autolisp :)

 

; error: AutoCAD variable setting rejected: CTABLESTYLE "Veteranus"

 

Edit: After creating a table syle called Veteranus it worked. But, can it write total lenght and area of selected layers instead of by one by?

Edited by veteranus
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...