desean Posted November 4, 2020 Posted November 4, 2020 Hello, i'm very new to lisp programming and i need some help to add a table to the current code (found the code in this forum too). A table that would show the all the attributes or details of QTY, PTNO, and DESC would be good. Thank you! This is the code: ;; Get all tags and values from block including constant attributes in following form: ;; (("TAG1" . "VALUE1") ("TAG2" . "VALUE2") ...("*CONSTANT*: TAGN" . "VALUEN")) (defun get-all-atts ( obj / att_lst catt_lst lst tag ) (setq att_lst (append (vlax-invoke obj 'getattributes) (setq catt_lst (vlax-invoke obj 'getconstantattributes))) lst nil );end_setq (foreach att att_lst (setq tag (vla-get-tagstring att)) (if (member att catt_lst) (setq lst (cons (cons (strcat "*CONSTANT*: " tag) (vla-get-textstring att)) lst)) (setq lst (cons (cons tag (vla-get-textstring att)) lst)) );end_if );end_foreach (setq lst (reverse lst)) );end_defun ;; Main part ;; (defun C:ATOUT ( / adoc axss com_data tot) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) osm (getvar "osmode") );end_setq (vla-endundomark adoc) (vla-startundomark adoc) (setvar "osmode" 0) (setvar "cmdecho" 0) (cond ( (ssget "_X" (list (cons 0 "INSERT")(cons 66 1)));;This will get you all attributed blocks in the drawing (setq com_data nil) (vlax-for a (setq axss (vla-get-activeselectionset adoc)) (setq com_data (cons (get-all-atts a) com_data)) );end_for (setq com_data (reverse com_data) tot (length com_data) );end_setq ) );end_cond (foreach x com_data (princ x) (princ "\n") );end_foreach (princ) (setvar "osmode" 0) (vla-endundomark adoc) );end_defun Quote
desean Posted November 4, 2020 Author Posted November 4, 2020 Currently, i have the attributes shown at the bottom, at the command center, like this. However, i want it to look like this. Does anyone know how to edit the code so that it will be shown like the one in the table? Quote
BIGAL Posted November 5, 2020 Posted November 5, 2020 Have a look at this http://www.lee-mac.com/blockcounter.html Quote
Jonathan Handojo Posted November 5, 2020 Posted November 5, 2020 1 hour ago, BIGAL said: Have a look at this http://www.lee-mac.com/blockcounter.html I don't think that's what he's after. That one counts all blocks. I built this one a long time ago, though I never had to use it, so I'm not sure if it will yield the intended result: (defun c:abcount (/ *error* acadobj activeundo adoc ats curlay dets i insp mm msp prp rtn ss vb vn) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (if (and (setq ss (ssget '((0 . "INSERT")))) (setq insp (getpoint "\nSpecify insertion point: ")) (setq curlay (getvar 'clayer)) ) (progn (repeat (setq i (sslength ss)) (if (setq vb (vlax-ename->vla-object (ssname ss (setq i (1- i)))) vn (vlax-get vb 'EffectiveName) ats (vlax-invoke vb 'GetAttributes) ) (progn (foreach x ats (setq prp (list vn (vla-get-TagString x) (vla-get-TextString x))) (if (setq mm (car (assoc prp dets))) (setq dets (mapcar '(lambda (y) (if (equal (car y) mm) (cons (car y) (1+ (cdr y))) y)) dets)) (setq dets (cons (cons prp 1) dets)) ) ) ) ) ) (if (setq lck (= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "layer" curlay))))))) (JH:ToggleLockLayer curlay)) (JH:list-to-table msp (cons '("Attribute Block Data") (cons '("Block Name" "Tag" "Value" "Count") (mapcar '(lambda (x) (list (caar x) (cadar x) (caddar x) (itoa (cdr x)) ) ) dets ) ) ) insp (getvar 'ctablestyle) ) (if lck (JH:ToggleLockLayer curlay)) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) ) ;; JH:list-to-table --> Jonathan Handojo ;; Creates a table from a list of lists of strings ;; space - ModelSpace or Paperspace vla object ;; lst - list of lists where each list is a list of strings ;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name ;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1" ;; pt - Insertion point of table (2 or 3 reals) ;; tblstyle - Table style to use (defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable) (setq ncols (apply 'max (mapcar 'length lst)) vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10) ) (vla-put-RegenerateTableSuppressed vtable :vlax-true) (vla-put-StyleName vtable tblstyle) (repeat (setq i (length lst)) (setq rows (nth (setq i (1- i)) lst)) (vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0))) (repeat (setq j (length rows)) (setq lens (cons (+ (abs (apply '- (mapcar 'car (textbox (list (cons 1 (setq txt (nth (setq j (1- j)) rows))) (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j)) ) ) ) ) ) (vlax-invoke vtable 'GetCellTextHeight i j) ) lens ) ) (if (eq (strcase (substr txt 1 7)) "<BLOCK>") (progn (setq blk (substr txt 8)) (if (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (vlax-method-applicable-p vtable 'setblocktablerecordid32) ) (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk))) (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true) ) ) (vla-SetText vtable i j txt) ) ) (setq totlen (cons lens totlen) lens nil) ) (repeat ncols (vla-SetColumnWidth vtable (setq ncols (1- ncols)) (apply 'max (vl-remove nil (mapcar '(lambda (x) (nth ncols x) ) totlen ) ) ) ) ) (vla-put-RegenerateTableSuppressed vtable :vlax-false) vtable ) ;; JH:ToggleLockLayer --> Jonathan Handojo ;; Toggles between locked and unlocked layers ;; nm - name of layer (defun JH:ToggleLockLayer (nm / obj) (if (setq obj (tblobjname "layer" nm)) (if (setq lck (cdr (assoc 70 (entget obj)))) (entmod (subst (cons 70 ((if (= 4 (logand 4 lck)) - +) 4 lck)) (cons 70 lck) (entget obj) ) ) ) ) ) (vl-load-com) Quote
BIGAL Posted November 5, 2020 Posted November 5, 2020 To desean like as Jonathan has suggested, I have something that creates a table of blocks and attributes, you can have as many block names as you like the blocks can have can as many attributes as you like, it sorts totals based on Blockname att1 att2 up to att 5. But can have as many attributes as you like tested on block with 25 attributes. Door1 Black Silverhandle 25 Door1 Black Goldhandle 15 Door2 Black Goldhandle 12 Door2 Silver Goldhandle 15 Door3 Silver Goldhandle embossedfinish 15 Its not a freebie but cheap. If you post a sample dwg happy to test to see if its what you want. Quote
desean Posted November 6, 2020 Author Posted November 6, 2020 (edited) On 11/5/2020 at 12:53 PM, Jonathan Handojo said: I don't think that's what he's after. That one counts all blocks. I built this one a long time ago, though I never had to use it, so I'm not sure if it will yield the intended result: (defun c:abcount (/ *error* acadobj activeundo adoc ats curlay dets i insp mm msp prp rtn ss vb vn) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (if (and (setq ss (ssget '((0 . "INSERT")))) (setq insp (getpoint "\nSpecify insertion point: ")) (setq curlay (getvar 'clayer)) ) (progn (repeat (setq i (sslength ss)) (if (setq vb (vlax-ename->vla-object (ssname ss (setq i (1- i)))) vn (vlax-get vb 'EffectiveName) ats (vlax-invoke vb 'GetAttributes) ) (progn (foreach x ats (setq prp (list vn (vla-get-TagString x) (vla-get-TextString x))) (if (setq mm (car (assoc prp dets))) (setq dets (mapcar '(lambda (y) (if (equal (car y) mm) (cons (car y) (1+ (cdr y))) y)) dets)) (setq dets (cons (cons prp 1) dets)) ) ) ) ) ) (if (setq lck (= 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "layer" curlay))))))) (JH:ToggleLockLayer curlay)) (JH:list-to-table msp (cons '("Attribute Block Data") (cons '("Block Name" "Tag" "Value" "Count") (mapcar '(lambda (x) (list (caar x) (cadar x) (caddar x) (itoa (cdr x)) ) ) dets ) ) ) insp (getvar 'ctablestyle) ) (if lck (JH:ToggleLockLayer curlay)) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) ) ;; JH:list-to-table --> Jonathan Handojo ;; Creates a table from a list of lists of strings ;; space - ModelSpace or Paperspace vla object ;; lst - list of lists where each list is a list of strings ;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name ;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1" ;; pt - Insertion point of table (2 or 3 reals) ;; tblstyle - Table style to use (defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable) (setq ncols (apply 'max (mapcar 'length lst)) vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10) ) (vla-put-RegenerateTableSuppressed vtable :vlax-true) (vla-put-StyleName vtable tblstyle) (repeat (setq i (length lst)) (setq rows (nth (setq i (1- i)) lst)) (vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0))) (repeat (setq j (length rows)) (setq lens (cons (+ (abs (apply '- (mapcar 'car (textbox (list (cons 1 (setq txt (nth (setq j (1- j)) rows))) (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j)) ) ) ) ) ) (vlax-invoke vtable 'GetCellTextHeight i j) ) lens ) ) (if (eq (strcase (substr txt 1 7)) "<BLOCK>") (progn (setq blk (substr txt 8)) (if (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (vlax-method-applicable-p vtable 'setblocktablerecordid32) ) (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk))) (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true) ) ) (vla-SetText vtable i j txt) ) ) (setq totlen (cons lens totlen) lens nil) ) (repeat ncols (vla-SetColumnWidth vtable (setq ncols (1- ncols)) (apply 'max (vl-remove nil (mapcar '(lambda (x) (nth ncols x) ) totlen ) ) ) ) ) (vla-put-RegenerateTableSuppressed vtable :vlax-false) vtable ) ;; JH:ToggleLockLayer --> Jonathan Handojo ;; Toggles between locked and unlocked layers ;; nm - name of layer (defun JH:ToggleLockLayer (nm / obj) (if (setq obj (tblobjname "layer" nm)) (if (setq lck (cdr (assoc 70 (entget obj)))) (entmod (subst (cons 70 ((if (= 4 (logand 4 lck)) - +) 4 lck)) (cons 70 lck) (entget obj) ) ) ) ) ) (vl-load-com) Thank you Jonathan for the code! Unfortunately, the result is not what i'm looking for. Thanks again! Edited November 6, 2020 by desean Quote
desean Posted November 6, 2020 Author Posted November 6, 2020 7 hours ago, BIGAL said: To desean like as Jonathan has suggested, I have something that creates a table of blocks and attributes, you can have as many block names as you like the blocks can have can as many attributes as you like, it sorts totals based on Blockname att1 att2 up to att 5. But can have as many attributes as you like tested on block with 25 attributes. Door1 Black Silverhandle 25 Door1 Black Goldhandle 15 Door2 Black Goldhandle 12 Door2 Silver Goldhandle 15 Door3 Silver Goldhandle embossedfinish 15 Its not a freebie but cheap. If you post a sample dwg happy to test to see if its what you want. Does it extract the attributes that I want, such as the Desc-S, Ptno-S, and QTY-S? I have attached a file for sample. sample blocks for test.dwg Quote
BIGAL Posted November 7, 2020 Posted November 7, 2020 This is what I ended up with is it what you want ? Can supply a trial version. Quote
desean Posted November 9, 2020 Author Posted November 9, 2020 On 11/7/2020 at 9:37 AM, BIGAL said: This is what I ended up with is it what you want ? Can supply a trial version. Unfortunately, it is not what I want. Thanks though! Quote
BIGAL Posted November 9, 2020 Posted November 9, 2020 You need to post what you want is it just the title stuff then you can just edit that. Just change, Block item1 Item2 Count. Quote
desean Posted November 9, 2020 Author Posted November 9, 2020 (edited) 2 hours ago, BIGAL said: You need to post what you want is it just the title stuff then you can just edit that. Just change, Block item1 Item2 Count. Information shown at command line. I just want the DESC-S, PTNO-S, QTY-S to be shown in a table rather than at the command line, like this. For the title stuff, I know I can just edit it. Edited November 9, 2020 by desean Quote
Jonathan Handojo Posted November 9, 2020 Posted November 9, 2020 (edited) I think I see what you're after... (defun c:test ( / i rtn ss tags) (setq tags ; these are the tags. They will appear left to right sorted in the order below '( "DESC-S" "PTNO-S" "QTY-S" ) ) (if (setq ss (ssget '((0 . "INSERT")))) (progn (repeat (setq i (sslength ss)) (setq rtn (cons (mapcar 'cdr (vl-sort (vl-remove nil (mapcar '(lambda (x / ps) (if (setq ps (vl-position (vla-get-TagString x) tags)) (cons ps (vla-get-TextString x)) ) ) ((lambda (x) (append (vlax-invoke x 'GetConstantAttributes) (vlax-invoke x 'GetAttributes))) (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ) ) ) '(lambda (a b) (< (car a) (car b))) ) ) rtn ) ) ) (JH:list-to-table (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (append '(("Data Extraction")) (list tags) (vl-remove nil rtn)) (getpoint "\nSpecify insertion point for table: ") (getvar 'ctablestyle) ) ) ) ) ;; JH:list-to-table --> Jonathan Handojo ;; Creates a table from a list of lists of strings ;; space - ModelSpace or Paperspace vla object ;; lst - list of lists where each list is a list of strings ;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name ;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1" ;; pt - Insertion point of table (2 or 3 reals) ;; tblstyle - Table style to use (defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable) (setq ncols (apply 'max (mapcar 'length lst)) vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10) ) (vla-put-RegenerateTableSuppressed vtable :vlax-true) (vla-put-StyleName vtable tblstyle) (repeat (setq i (length lst)) (setq rows (nth (setq i (1- i)) lst)) (vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0))) (repeat (setq j (length rows)) (setq lens (cons (+ (abs (apply '- (mapcar 'car (textbox (list (cons 1 (setq txt (nth (setq j (1- j)) rows))) (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j)) ) ) ) ) ) (vlax-invoke vtable 'GetCellTextHeight i j) ) lens ) ) (if (eq (strcase (substr txt 1 7)) "<BLOCK>") (progn (setq blk (substr txt 8)) (if (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (vlax-method-applicable-p vtable 'setblocktablerecordid32) ) (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk))) (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true) ) ) (vla-SetText vtable i j txt) ) ) (setq totlen (cons lens totlen) lens nil) ) (repeat ncols (vla-SetColumnWidth vtable (setq ncols (1- ncols)) (apply 'max (vl-remove nil (mapcar '(lambda (x) (nth ncols x) ) totlen ) ) ) ) ) (vla-put-RegenerateTableSuppressed vtable :vlax-false) vtable ) Edited November 9, 2020 by Jonathan Handojo 1 Quote
desean Posted November 9, 2020 Author Posted November 9, 2020 5 minutes ago, Jonathan Handojo said: I think I see what you're after... (defun c:test ( / i rtn ss tags) (setq tags ; these are the tags. They will appear left to right sorted in the order below '( "DESC-S" "PTNO-S" "QTY-S" ) ) (if (setq ss (ssget '((0 . "INSERT")))) (progn (repeat (setq i (sslength ss)) (setq rtn (cons (mapcar 'cdr (vl-sort (vl-remove nil (mapcar '(lambda (x / ps) (if (setq ps (vl-position (vla-get-TagString x) tags)) (cons ps (vla-get-TextString x)) ) ) (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'GetConstantAttributes) ) ) '(lambda (a b) (< (car a) (car b))) ) ) rtn ) ) ) (JH:list-to-table (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (append '(("Data Extraction")) (list tags) (vl-remove nil rtn)) (getpoint "\nSpecify insertion point for table: ") (getvar 'ctablestyle) ) ) ) ) ;; JH:list-to-table --> Jonathan Handojo ;; Creates a table from a list of lists of strings ;; space - ModelSpace or Paperspace vla object ;; lst - list of lists where each list is a list of strings ;; => if you wish to insert a block in the cell, prefix using "<block>" followed by the block name ;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1" ;; pt - Insertion point of table (2 or 3 reals) ;; tblstyle - Table style to use (defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable) (setq ncols (apply 'max (mapcar 'length lst)) vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10) ) (vla-put-RegenerateTableSuppressed vtable :vlax-true) (vla-put-StyleName vtable tblstyle) (repeat (setq i (length lst)) (setq rows (nth (setq i (1- i)) lst)) (vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0))) (repeat (setq j (length rows)) (setq lens (cons (+ (abs (apply '- (mapcar 'car (textbox (list (cons 1 (setq txt (nth (setq j (1- j)) rows))) (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j)) ) ) ) ) ) (vlax-invoke vtable 'GetCellTextHeight i j) ) lens ) ) (if (eq (strcase (substr txt 1 7)) "<BLOCK>") (progn (setq blk (substr txt 8)) (if (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (vlax-method-applicable-p vtable 'setblocktablerecordid32) ) (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk))) (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true) ) ) (vla-SetText vtable i j txt) ) ) (setq totlen (cons lens totlen) lens nil) ) (repeat ncols (vla-SetColumnWidth vtable (setq ncols (1- ncols)) (apply 'max (vl-remove nil (mapcar '(lambda (x) (nth ncols x) ) totlen ) ) ) ) ) (vla-put-RegenerateTableSuppressed vtable :vlax-false) vtable ) Hey, thanks so much! This is exactly what i'm looking for. But there's a slight bug with QTY-S. It does not show for some of the components. Quote
Jonathan Handojo Posted November 9, 2020 Posted November 9, 2020 (edited) I already re-edit the code, I forgot it wasn't just the constant attributes, but also the changing attributes. Refresh the page Edited November 9, 2020 by Jonathan Handojo 1 Quote
desean Posted November 9, 2020 Author Posted November 9, 2020 3 minutes ago, Jonathan Handojo said: I already re-edit the code, I forgot it wasn't just the constant attributes, but also the changing attributes. Refresh the page Oh wow! It works, thank you so much!!! Quote
BIGAL Posted November 10, 2020 Posted November 10, 2020 The code provided takes into account the variation in the attributes not just block name so counts the block name and variations there of. Quote
desean Posted November 11, 2020 Author Posted November 11, 2020 23 hours ago, BIGAL said: The code provided takes into account the variation in the attributes not just block name so counts the block name and variations there of. Jonathan Handojo's code is sufficient for me, thanks, though! Quote
desean Posted November 12, 2020 Author Posted November 12, 2020 On 11/9/2020 at 3:07 PM, Jonathan Handojo said: I already re-edit the code, I forgot it wasn't just the constant attributes, but also the changing attributes. Refresh the page Jonathan, do you know how can I expand the width of the table? Quote
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.