veteranus Posted May 9 Share Posted May 9 Hello, Can I write to all my selected poyline, lines, rectangles or anything total lenght and area to a table with selected layer name. Example.dwg Quote Link to comment Share on other sites More sharing options...
devitg Posted May 9 Share Posted May 9 (edited) 1 hour ago, veteranus said: Hello, Can I write to all my selected poyline, lines, rectangles or anything total lenght and area to a table with selected layer name. Example.dwg 100.69 kB · 2 downloads @veteranus you can use DATAEXTRACTION Example+dataextraction.dwg Edited May 9 by devitg add dwg Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 10 Share Posted May 10 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) Quote Link to comment Share on other sites More sharing options...
veteranus Posted May 10 Author Share Posted May 10 (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 May 10 by veteranus Quote Link to comment Share on other sites More sharing options...
BIGAL Posted May 10 Share Posted May 10 Will check must have a typo in code. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.