BHenry85 Posted December 19, 2024 Author Posted December 19, 2024 (edited) I'm coming back to the original version of this code due to some a new request to try and capture similar nested blocks, and possibly ones that are within external references. Problem 1: When I went to test the base functionality, it appears that this version is no longer capturing all of the blocks named "detailbubble" as originally intended. Problem 2: In addition to the original script, it now prompt the user for a save location and then prompts to open the file if the user. The problem that I'm having is the path for the filename contains forward slash, but if the user opens the file and there is a space in the path, then it treats that as an enter, which I expected. So, I found a code snippet that should convert the forward slash to a double slash, but it doesn't appear to be working properly. Problem 3: I want to include nested blocks and external references into the list, but I don't know where to start. I have searched across most of the popular platforms and find pages that are close, but can't find something that isn't extremely complex that I could pull just the core functionality from. I have included my script and files to test with. Thank you in advance for any and all input. Large Reference.dwgUnavailable Large Reference-BH.dwgUnavailable DetailExtractor.lspUnavailable Edited December 20, 2024 by BHenry85 Updated DetailExtractor.lsp Quote
BIGAL Posted December 19, 2024 Posted December 19, 2024 A few comments. The code has a copyright notice. Are you part of the Toll group ? This may not be correct it only removes duplicate numbers. You need a different remove duplicate function that looks at list values numbers or strings or combinations. (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))) ;remove duplicates You can write direct to Excel no need for CSV file. Quote
BHenry85 Posted December 20, 2024 Author Posted December 20, 2024 On 12/19/2024 at 11:48 PM, BIGAL said: The code has a copyright notice. Are you part of the Toll group ? Yes, I work for them and thought I had removed that section from the top prior to uploading. Quote
BHenry85 Posted December 20, 2024 Author Posted December 20, 2024 On 12/19/2024 at 11:48 PM, BIGAL said: You can write direct to Excel no need for CSV file. The users want to have a file to reference to, so we had it write to a csv originally. Are saying it can write to a temporary excel document and then open that in Excel so they can copy the list and do what they need, followed by them closing and not saving the temporary file? Quote
BIGAL Posted December 20, 2024 Posted December 20, 2024 The simplest way is don't have Excel open it will make a new one and then populate it. Is this all it outputs ? Try this. ; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/ ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ (defun DEXT (/ dname ss blk file lst ) (vl-load-com) ;======================================================================================================================================== ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) );defun ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext ( row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'Item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring))) ) (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "DetailBubble")))) ;get detail blocks (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myXL :vlax-true) (vlax-put-property myxl 'ScreenUpdating :vlax-true) (vlax-put-property myXL 'DisplayAlerts :vlax-true) (vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ; opens a new xl (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq blk (vlax-ename->vla-object ent)) (setq x (strcat (LM:vl-getattributevalue blk "DETAIL_NUMBER") "-" (LM:vl-getattributevalue blk "SHEET_NUMBER"))) ;get attributes (if (assoc x lst) (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst)) ;get list of values (setq lst (cons (cons x 1) lst)) ;create list ) ) (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b))))) ;remove duplicates (setq row 0) (foreach itm lst (xlsetcelltext (setq row (1+ row)) 1 (strcat (car itm))) (princ row) ) ) ) (princ) );defun Quote
BHenry85 Posted December 31, 2024 Author Posted December 31, 2024 On 12/20/2024 at 2:59 AM, BIGAL said: The simplest way is don't have Excel open it will make a new one and then populate it. Is this all it outputs ? Try this. Yes, the command should just list only the details that are inserted into the drawing, remove any duplicates, and then spit those out into an alphabetized list. The version you provided does open a new instance of excel and exports the list of some details, which is neat, but it still isn't the full list of details that are in the drawing. Quote
ronjonp Posted December 31, 2024 Posted December 31, 2024 (edited) On 12/31/2024 at 6:07 PM, BHenry85 said: ... but it still isn't the full list of details that are in the drawing. This is because these are dynamic blocks that have been modified which creates an anonymous block name ( *U# ) and the ssget filter is looking for "DetailBubble". Give this a try ... it tallies your detail blocks that have duplicate values. I did not read this whole thread so hopefully that is what you're trying to do ; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/ ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ (defun c:dext (/ blk cells lst myxl row ss x) (vl-load-com) ;======================================================================================================================================== ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;defun ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) (if (setq ss (ssget "_X" '((0 . "INSERT")))) ;get detail blocks (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) ; opens a new xl (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;; RJP - Check the effective name of all blocks (if (= "DetailBubble" (vla-get-effectivename (setq blk (vlax-ename->vla-object ent)))) (progn (setq x (strcat (lm:vl-getattributevalue blk "DETAIL_NUMBER") "-" (lm:vl-getattributevalue blk "SHEET_NUMBER") ) ) ;get attributes ;; RJP - are you trying to tally duplicates? (if (assoc x lst) (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst)) ;get list of values (setq lst (cons (cons x 1) lst)) ;create list ) ) ) ) ;; RJP - This sorts the list by attribute values (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b))))) (setq row 1) (xlsetcelltext row 1 "ATTRIBUTES") (xlsetcelltext row 2 "TOTAL DUPLICATES") (foreach itm lst (xlsetcelltext (setq row (1+ row)) 1 (car itm)) (xlsetcelltext row 2 (cdr itm)) ) ) ) (princ) ) ;defun This is the result for your 'Large Reference' drawing: ATTRIBUTES TOTAL DUPLICATES ADF-2004 4 AEX-NE01 24 BRK-0101 6 BRK-0104 2 BRK-0108 15 BRK-0115 2 BRK-0201 3 BRK-0411 25 BRK-0418 18 BRK-0426 4 BRK-0427 4 BRK-0610 6 BRK-0612 3 BRK-0702 6 BRK-0705 6 BRK-0710 6 BRK-0801 6 BRK-0810 6 BRK-0815 6 BRK-0832 14 CMS-0101 14 CMS-0201 9 CMS-0202 30 CMS-0411 3 CMS-0420 3 CMS-0617 11 CMS-0618 3 CMS-0701 20 CMS-0702 20 CMS-0703 20 CMS-0721 3 CMS-0722 3 CMS-0723 3 CMS-0815 6 CMS-0820 6 DPL-0201 3 DPL-0202 6 DRT-0110 9 MSV-0101 1 MSV-0102 2 MSV-0104 3 MSV-0202 3 MSV-0421 5 MSV-0602 3 MSV-0701 3 MSV-0704 6 MSV-0705 3 MSV-0801 3 MSV-0802 3 MSV-0805 2 RFM-0202 1 RFM-0220 3 RFM-0224 9 RFM-0225 3 RFM-0226 3 RFM-0601 9 SFD-0113 12 SFD-0114 2 SFD-0154 2 SFD-2101 1 SFF-0102 16 SFF-0103 8 SFF-0107 8 SFF-0109 26 SFF-0112 56 SFF-0123 2 SFL-0150 6 SFL-0153 13 SFL-0160 13 SFR-0112 9 SNB-0101 7 SNB-0103 5 SNB-0108 18 SNB-0109 7 SNB-0111 6 SNB-0112 8 SNB-0113 8 SNB-0119 5 SNC-2101 18 SNC-2104 12 SNC-2105 6 SNC-2106 3 SNC-2107 9 SNC-2117 3 SNC-2119 3 SNC-2120 9 SNS-2100 24 SNS-2200 26 SNS-2201 15 SNS-2203 6 SNS-2204 12 SNS-2206 4 SNS-2207 5 SNS-2209 9 SNS-2210 18 SNS-2212 9 SNS-2213 1 TRM-0610 9 Edited December 31, 2024 by ronjonp Quote
ronjonp Posted December 31, 2024 Posted December 31, 2024 Here's a version that reports used values with duplicates removed: ; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/ ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ (defun c:dext (/ blk cells lst myxl row ss x) (vl-load-com) ;======================================================================================================================================== ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;defun ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) (if (setq ss (ssget "_X" '((0 . "INSERT")))) (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) ; opens a new xl (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;; RJP - Check the effective name of all blocks (if (= "DetailBubble" (vla-get-effectivename (setq blk (vlax-ename->vla-object ent)))) (progn (setq x (strcat (lm:vl-getattributevalue blk "DETAIL_NUMBER") "-" (lm:vl-getattributevalue blk "SHEET_NUMBER") ) ) ;get attributes (or (member x lst) (setq lst (cons x lst))) ) ) ) ;; RJP - This sorts the list by attribute values (setq lst (vl-sort lst '<)) (setq row 0) (foreach itm lst (xlsetcelltext (setq row (1+ row)) 1 itm)) ) ) (princ) ) ;defun Quote
BHenry85 Posted December 31, 2024 Author Posted December 31, 2024 (edited) On 12/31/2024 at 7:59 PM, ronjonp said: Here's a version that reports used values with duplicates removed: This works as I want it to for the typical block insertions, but I noticed the first line in the excel has some random numbers that are being formatted as a date. Also, is there way to capture similar "DetailBubble" blocks that are within nested blocks in the sample drawing and possibly within external references? Sample Output.xlsxFetching info... Edited December 31, 2024 by BHenry85 Updated sample attachment Quote
ronjonp Posted December 31, 2024 Posted December 31, 2024 (edited) One of your blocks data has 8-3 .. Excel thinks it's helping by turning it into a date. The only way I know to force the value is to prefix it with `. With the value escaped: Edited December 31, 2024 by ronjonp Quote
BHenry85 Posted December 31, 2024 Author Posted December 31, 2024 On 12/31/2024 at 8:57 PM, ronjonp said: One of your blocks data has 8-3 .. Excel thinks it's helping by turning it into a date. The only way I know to force the value is to prefix it with `. That makes perfect sense. I appreciate the insight. Do you have any way to capture nested versions of the blocks and/or external references that include them? Quote
ronjonp Posted December 31, 2024 Posted December 31, 2024 (edited) On 12/31/2024 at 9:16 PM, BHenry85 said: That makes perfect sense. I appreciate the insight. Do you have any way to capture nested versions of the blocks and/or external references that include them? @BHenry85 Give this version a try for nested values. ;; https://www.cadtutor.net/forum/topic/75699-remove-duplicates-in-list/page/2/#findComment-660223 ;; Detail Extractor v2.5.lsp ;; Write list of details used in model/lot to csv file in location defined by user ;; Removes duplicates from list and only lists unique values ;; Prompts user to open file once complete or not ;; ______________________________________________________________________________________ ;; RJP » 2025-01-01 - REWRITE (defun c:dext (/ a b blk cells lst myxl row x) (vl-load-com) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun lm:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att) ) ) (vlax-invoke blk 'getattributes) ) ) ;; Thanks to fixo ;; = Set Excel cell text = (defun xlsetcelltext (row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring)) ) ) ;; RJP » GET NESTED VALUES (vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-for blk a (if (and (= "AcDbBlockReference" (vla-get-objectname blk)) (= -1 (vlax-get blk 'hasattributes)) (setq a (lm:vl-getattributevalue blk "DETAIL_NUMBER")) (setq b (lm:vl-getattributevalue blk "SHEET_NUMBER")) ) (or (member (setq x (strcat "`" a "-" b)) lst) (setq lst (cons x lst))) ) ) ) (if lst (progn (or (setq myxl (vlax-get-object "Excel.Application")) (setq myxl (vlax-get-or-create-object "Excel.Application")) ) (vla-put-visible myxl :vlax-true) (vlax-put-property myxl 'screenupdating :vlax-true) (vlax-put-property myxl 'displayalerts :vlax-true) (vlax-invoke-method (vlax-get-property myxl 'workbooks) 'add) (setq row 0) (foreach itm (vl-sort lst '<) (xlsetcelltext (setq row (1+ row)) 1 itm)) ) (print "NO VALUES FOUND...") ) (princ) ) Edited January 1 by ronjonp 1 Quote
BHenry85 Posted January 9 Author Posted January 9 On 12/31/2024 at 9:45 PM, ronjonp said: Give this version a try for nested values. This version appears to be doing the trick. Thank you so much for your time on this matter! Quote
ronjonp Posted January 9 Posted January 9 On 1/9/2025 at 4:21 PM, BHenry85 said: This version appears to be doing the trick. Thank you so much for your time on this matter! Quote
BHenry85 Posted January 21 Author Posted January 21 So, after some user testing, I have run into a few issues and a new feature request. When we ran this on some test files, we found that it was providing more details than was actually in the file. I don't know how this is possible because the detail bubbles all use the same block and it's only the attributes that vary and what should be what is captured. Ironically, performing a purge on the file, as well any references, then running the command again provides the correct results. The issue I don't know how to resolve is that the command seems to break if you run it on a file that has a large amount of detail bubbles. (I have attached a reference file for testing locally that has 1166.) When running the command, I see it launch Excel but it has no contents. Smaller test files work properly, but we have some master files that are rather large and this is where it breaks. Lastly, they are requesting the ability to list the hyperlinks beside the detail list. One of the original versions of this command included hyperlinks, so I pulled some lines of code from that and tried making this latest version do the same thing. I started by adding (setq c (vlax-get-property blk 'Hyperlinks)), then added the new "c" var in the strcat line below it with a comma separation. When I run it, I get an error stating "bad argument type: stringp #<VLA-OBJECT IAcadHyperlinks 00000164d8b1dc68>" Is this breaking due to a conflict with the vlax-get and the vlax-get-property functions? (vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-for blk a (if (and (= "AcDbBlockReference" (vla-get-objectname blk)) (= -1 (vlax-get blk 'hasattributes)) (setq a (lm:vl-getattributevalue blk "DETAIL_NUMBER")) (setq b (lm:vl-getattributevalue blk "SHEET_NUMBER")) (setq c (vlax-get-property blk 'Hyperlinks)) ) (or (member (setq x (strcat "`" a "-" b "," c)) lst) (setq lst (cons x lst))) ) ) ) Large Reference.dwgFetching info... Quote
BIGAL Posted January 21 Posted January 21 What happens when there is no hyperlink ? it fails, do you need a IF to check before doing the strcat. Quote
BHenry85 Posted January 21 Author Posted January 21 I suck at nested IF conditions. Lol. If it could state something like "No link available", then that would work. Quote
mhupp Posted January 22 Posted January 22 Have you tried attout from express tools? Creates a text file just load that into excel by dragging it. Used this to update a 100's of blocks with attributes ones the changes i wanted were inputted save the text file close excel and use attin to sync them up. Quote
BIGAL Posted January 22 Posted January 22 This is where you would do the (if (= c nil) dont process further if c is nil. Or maybe do a strcat a & b only. ) (or (member (setq x (strcat "`" a "-" b "," c)) lst) (setq lst (cons x lst))) Quote
ronjonp Posted January 22 Posted January 22 (edited) Untested but try something like this: (vlax-for a (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-for blk a (if (and (= "AcDbBlockReference" (vla-get-objectname blk)) (= -1 (vlax-get blk 'hasattributes)) (setq a (lm:vl-getattributevalue blk "DETAIL_NUMBER")) (setq b (lm:vl-getattributevalue blk "SHEET_NUMBER")) (or (and (setq c (vlax-get-property blk 'Hyperlinks)) (setq c (vla-get-url (vla-item c 0))) ) (setq c "NO HYPERLINK") ) ) (or (member (setq x (strcat "`" a "-" b "," c)) lst) (setq lst (cons x lst)) ) ) ) ) Edited Thursday at 05:28 PM by ronjonp 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.