Jump to content

Recommended Posts

Posted (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 by BHenry85
Updated DetailExtractor.lsp
Posted

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.

Posted
  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. 

Posted
  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?

Posted

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

 

  • 2 weeks later...
Posted
  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. 

Posted (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 by ronjonp
Posted

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

 

Posted (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 by BHenry85
Updated sample attachment
Posted (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 `.

 

image.png.7f848bf81c72c6f883887663f68b9a9e.png

 

With the value escaped:
image.png.ca9d4b6ab3f111d0e343a7c5202b07ab.png

Edited by ronjonp
Posted
  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? 

Posted (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 by ronjonp
  • Thanks 1
  • 2 weeks later...
Posted
  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!

Posted
  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!

:beer:

  • 2 weeks later...
Posted

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...

Posted

What happens when there is no hyperlink ? it fails, do you need a IF to check before doing the strcat. 

Posted

I suck at nested IF conditions. Lol. If it could state something like "No link available", then that would work. 

Posted

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.

 

 

Posted

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)))

 

Posted (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 by ronjonp

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.

×
×
  • Create New...