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.dwg Large Reference-BH.dwg

 

DetailExtractor.lsp

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

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

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

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

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