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.dwg Large Reference-BH.dwg DetailExtractor.lsp 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 2 hours ago, 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 2 hours ago, 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/19/2024 at 8:59 PM, 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) 1 hour ago, 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) 38 minutes ago, 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.xlsx 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 18 minutes ago, 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) 19 hours ago, 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 Wednesday at 05:11 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.