Remove Duplicates in List

[BHenry85]

I found a lisp located below and made some modifications to it that will allow me to extract all of the values of block and then write them to a csv file. But, I am having a problem trying to remove the duplicates without breaking the code. I get the concept of the idea that I have seen in other posts, but the code I found that does the majority of what I need compiles all of the tags and their values and writes them to a list and I am confused on how to remove the duplicates with the way that it gathers these values. I have attached a file where I have deliberately duplicated the tags for testing the removal of duplicates. I apologize in advance for not being to lisp savvy, but can someone assist in pointing me how to do so?

 

Example of how to approach a single item and remove the duplicates from what I gather.

(if (member item data)
     data
     (cons item data))

 

The code that that I found with a link to the original page, but modified to fit my needs.

; Global ATTribute EXtractor 
; by Miklos Fuccaro mfuccaro@hotmail.com
; https://www.cadtutor.net/forum/topic/68808-export-enhanced-attributes-editor-values-to-excel/
;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract

(defun DBEXT  ()
 
; define block and attributes
 (setq Blocklist '("DetailBubble"))
 (setq TagList '("DETAIL_NUMBER" "SHEET_NUMBER" ))
 
; create block names separated by columns, for selection filter
 (setq Blocknames (List2String BlockList))
 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
 (if (not ss)
   (quit))
   
 (setq Root (getvar "DWGPREFIX"))
 (setq file (open (strcat Root "_Details.csv") "w")
       i    -1)
 (repeat (sslength ss)
   (setq TagRow nil
         ValRow nil)
   (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
   (while (/= (Dxf 0 Edata) "SEQEND")
     (if
       (and
         (= (Dxf 0 Edata) "ATTRIB")
         (member (dxf 2 Edata) TagList)
         ;;if tag is on list
         ) ;and
        (progn
          (setq TagRow (cons (Dxf 2 Edata) TagRow))
          (setq valRow (cons (Dxf 1 Edata) ValRow))
          ) ;progn
        )
     (setq Edata (entget (setq e (entnext e))))
     ) ;while
   (write-line (List2String (reverse ValRow)) file)
   ) ;repeat 
 (close file)
 (princ (strcat "\nDone writing file " Root "_Details.csv"))
 (princ)
 ) ;defun


(defun List2String  (Alist)
 (setq NumStr (length Alist))
	(foreach Item  AList
	   (if (= Item (car AList))
		 ;;first item
		 (setq LongString (car AList)) ; write tag
		 (setq LongString (strcat LongString "-" Item)) ; write value
		)
	)
 LongString
) ;defun


(defun Dxf  (code pairs)
 (cdr (assoc code pairs))
)
(princ)

(DBEXT)

 

Small Reference.dwg

Edited July 29, 2022 by BHenry85

[marko_ribar]

The quick one and very suiccint to remember - author : Gilles Chantaux...

 

(defun unique ( l )
  (if l
    (cons (car l)
      (unique
        (vl-remove-if
          (function (lambda ( x )
            (equal (car l) x 1e-6)
          ))
          (cdr l)
        )
      )
    )
  )
)

 

[marko_ribar]

Here is another one - author is me : Marko Ribar...

Iterative version - maybe better with exhaustive lists :

 

(defun unique ( l / a ll )
  (while (setq a (car l))
    (if (vl-some (function (lambda ( x ) (equal x a 1e-6))) (cdr l))
      (setq ll (cons a ll) l (vl-remove-if (function (lambda ( x ) (equal x a 1e-6))) (cdr l)))
      (setq ll (cons a ll) l (cdr l))
    )
  )
  (reverse ll)
)

 

[BHenry85]

Do you think you can work that into the code that I have above? I would greatly appreciate it and thank you ahead of time. 

[mhupp]

1 hour ago, BHenry85 said:

Do you think you can work that into the code that I have above? I would greatly appreciate it and thank you ahead of time. 

 

look how you call/use List2String

(setq listname (unique listname))

 

Edited July 29, 2022 by mhupp

[BHenry85]

I have tried inserting the UNIQUE function as you show above in a few locations, but nothing works. As I previously stated, the code that shared on the first post was not done by me, but I did change the block name and attributes that I was looking to have listed. Does the UNIQUE function get inserted in the DBEXT function or within LISTSTRING function? It would help if you could tell me what lines to change and what to change it to. 

[mhupp]

So this lisp doesn't really build a "list" to compare unique values. it outputs in real time to the csv file with the line

 

(write-line (List2String (reverse ValRow)) file)

 

So their is only one item in the "list" at a time because its always being over written with each loop. to run @marko_ribar unique function the while function would have to process and store that data in a bigger list. then run unique on that list and once that has been processed output to a csv file.

 

I would need to see a example drawing and spread sheet to re-code it.

 

Edited July 30, 2022 by mhupp
Didn't see the file in the first post.

[BIGAL]

Just a comment looking at duplicates can also be expanded to include counting so get block1 24, block2 32 etc. 

[mhupp]

Did a complete re write. outputs to a txt file instead of csv don't have excel at home.

 

Will display as

BRK-0104 Found 2 Times
BRK-0108 Found 2 Times
BRK-0148 Found 2 Times
BRK-0201 Found 2 Times
BRK-0212 Found 2 Times

....

RFM-0220 Found 6 Times

 

;;----------------------------------------------------------------------;;
;; LIST BLOCK ATTRIBUTE CALLOUTS AND HOW MANY TIMES FOUND
(defun C:DBEXT (/ TagList ss root file i TagRow ValRow Edata lst)
  (vl-load-com)
  (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "DetailBubble"))))
    (progn
      (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")))
        (if (assoc x lst) 
          (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst))
          (setq lst (cons (cons x 1) lst))
        )
      )
      (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b))))
            file (open (strcat (getvar 'DWGPREFIX) "Details.txt") "w")
      )      
      (foreach itm lst
        (if (> (cdr itm) 1)
          (write-line (strcat (car itm) " Found "  (rtos (cdr itm)2 0) " Times") file)
          (write-line (strcat (car itm) " Found "  (rtos (cdr itm)2 0) " Time") file)
        )
      )
      (close file)
      (startapp "notepad" (strcat (getvar 'DWGPREFIX) "Details.txt"))
    )
  )  
  (princ)
)
;; 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))
)

 

[BHenry85]

This is perfect and just what I was needing. I did make a slight change because I am looking for a list of unique value that we can pull into another scripting language to perform additional actions. So, I removed the count information within the write line so it will only list the detail values only. 

 

; Removed the following
	  (foreach itm lst
        (if (> (cdr itm) 1)
          (write-line (strcat (car itm) " Found "  (rtos (cdr itm)2 0) " Times") file)
          (write-line (strcat (car itm) " Found "  (rtos (cdr itm)2 0) " Time") file)
        )
      )

; Replace with
      (foreach itm lst
        (if (> (cdr itm) 1)
          (write-line (strcat (car itm)) file)
          (write-line (strcat (car itm)) file)
        )
      )

 

So the final version of the code if needed by future users is:

 

;; Write list of unique details to csv file in dwg folder
(defun DBEXT (/ TagList ss root file i TagRow ValRow Edata lst)
  (vl-load-com)
  (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "DetailBubble"))))
    (progn
      (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")))
        (if (assoc x lst)
          (setq lst (subst (cons x (1+ (cdr (assoc x lst)))) (assoc x lst) lst))
          (setq lst (cons (cons x 1) lst))
        )
      )
      (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b))))
            file (open (strcat (getvar 'DWGPREFIX) "_Details.csv") "w")
      )
      (foreach itm lst
        (if (> (cdr itm) 1)
          (write-line (strcat (car itm)) file)
          (write-line (strcat (car itm)) file)
        )
      )
      (close file)
	  (startapp "C:/Program Files (x86)/Microsoft Office/root/Office16/EXCEL.EXE" (strcat (getvar 'DWGPREFIX) "_Details.csv"))
    )
  )
  (princ)
  (princ "\nSaved Details CSV File!\n")
  (princ)
);defun

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

 

Thank you so much for your time and help on this everyone. Cheers!

[Tharwat]

32 minutes ago, BHenry85 said:

; Replace with
      (foreach itm lst
        (if (> (cdr itm) 1)
          (write-line (strcat (car itm)) file)
          (write-line (strcat (car itm)) file)
        )
      )

There is no benefit of checking if the (cdr itm) is bigger than one because the following two statements are the same.

[mhupp]

7 minutes ago, Tharwat said:

There is no benefit of checking if the (cdr itm) is bigger than one because the following two statements are the same.

 

That's left over from when i had and output that of the count as well.

 

but your right only needs this.

(foreach itm lst
  (write-line (strcat (car itm)) file)
)

 

[BHenry85]

I made the adjustment on my side. Thanks again gentlemen!

[BHenry85]

So, the plot thickens. Is there a way to include the hyperlink info (external hyperlink in properties with block selected and not within the block)? I found some code shown below on a forum page that will produce a list of all of the hyperlinks of selected blocks, but I need this to maintain the previous list functions of removing duplicates, but append the hyperlink of that block to the list. 

 

 

; https://www.cadtutor.net/forum/topic/63138-extract-hyperlink-from-block/
; extract hyperlinks outside of block
(defun c:ExHyp (/ )

(vl-load-com)

(setq File1 (getfiled "Save File" (strcat "Export - "(menucmd "M=$(edtime,$(getvar,date),MO-DD-YYYY)")) "txt" 1))
(setq Fopen (open File1 "w"))

(setq ss_mm (ssget (list (cons 0 "INSERT"))))
(setq Ecount 0)

(repeat (sslength ss_mm)
		
	(setq mm_obj (vlax-ename->vla-object (ssname ss_mm Ecount)))
	(setq mm_txt (vlax-get-property mm_obj 'Hyperlinks))
	
		(progn 
			
		(vlax-for each mm_txt 

		(setq hyp_txt (strcat (vla-get-url each)))
		(write-line hyp_txt Fopen)
		(setq Ecount (1+ Ecount))
		
		) 

		)
)

(close Fopen)
(princ)

)

 

 

 

[mhupp]

One of your blocks doesn't have a link and held me up for 30 mins tying to fig out why it kept giving me an error.

 

;; Write list of unique details to csv file in dwg folder
(defun C:DBEXT (/ ss ent blk x hyprlnk link lst file itm)
  (vl-load-com)
  (if (setq ss (ssget "_X" '((0 . "INSERT") (2 . "DetailBubble"))))
    (progn
      (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")))
        (setq hyprlnk (vlax-get-property blk 'Hyperlinks))
        (if (> (vlax-get-property hyprlnk 'Count) 0)
          (progn
            (setq hyprlnk (vla-item hyprlnk 0))
            (setq link (vlax-get-property hyprlnk 'URL))
          )
          (setq link "Link Not Found")
        )          
        (or (assoc x lst) (setq lst (cons (cons x link) lst)))
      )
      (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b))))
            file (open (strcat (getvar 'DWGPREFIX) "_Details.csv") "w")
      )
      (foreach itm lst
        (write-line (strcat (car itm) " - " (cdr itm)) file)
      )
      (close file)
      (startapp "C:/Program Files (x86)/Microsoft Office/root/Office16/EXCEL.EXE" (strcat (getvar 'DWGPREFIX) "_Details.csv"))
    )
  )
  (princ "\nSaved Details CSV File!")
  (princ)
)

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

 

Edited August 4, 2022 by mhupp
ronjonp suggestion added

[BHenry85]

Perfect! Thank you again good sir for all of your help. 

[BHenry85]

So after some further testing and flexing the code, I am finding that it does not capture. I noticed this at first during a test with a file and thought that it might be caused with the block had a value in the "SIM-TYP" attribute, but when testing again on our master detail tag block, it was doing it there as well. I have 1634 detail blocks with unique values and only 814 actually get listed in the csv file. Any thoughts on what might be causing this?

NADs.dwg NADs_Details and Hyperlinks.csv DBHEXT.lsp

[mhupp]

After using overkill their are 815 block left. 813 rows in csv file.

 

--edit

There are two RFM-0601 and two MVS-0201

Edited August 4, 2022 by mhupp

[ronjonp]

@mhupp Nice code

 

FWIW, when you're checking if the item exists in the 'lst' you could also use OR logic like so:

(or (assoc x lst) (setq lst (cons (cons x link) lst)))

 

[BHenry85]

Simple enough. Apparently I double inserted them without knowing. Thank you for checking into this for me.