Attributes Extraction in a Specific Format

[savinirsb4u]

Hello Lisp guru's,

I need a lisp to extract attributes from autocad block to excel in a specific format.
In my drawing I have a few blocks which are having four attribute tags named as TAG_1, TAG_2, TAG_3 & TAG_4

from each block TAG_1 values should be pasted in column 1 (A) staring from 2nd row, Tag_2 values should be pasted in Column 2 (B).
and Tag_4 Should be pasted in 1st Row (CC). All the Tag_4 values are numerical so the values should be starting from 1, 2 , 3 , 4 etc.
Tag_3 values should be populate based on the Tag_4 value.
Please find the below picture for reference.

Tag_1 & Tag_2 values are alpha numeric values. and Tag_3 values are numeric only.
Please help me out as I have researched alot in so many forums but I couldn't get any idea to make the script.

[Roy_043]

The rows that start with a yellow cell have 2 or 3 TAG_3 values. Can you explain that?

[savinirsb4u]

Hi Roy, thanks for responding my query. Here I have attached the sample drawing containing with the blocks to extract.

Also attached the snip of required output of the attribute values in excel.

Tag_3 values are depends on number of blocks in my design and also Tag_3 value should represent the quantity of Tag_4.

Sorry for my bad english.

Drawing check.dwg

[Roy_043]

A bit harder than I thought:

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

; (BlockMode1_GetAttributes (car (entsel))) => (("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))
(defun BlockMode1_GetAttributes (enm / obj)
  (setq obj (vlax-ename->vla-object enm))
  (if (= "BLOCK MODE_1" (strcase (vla-get-effectivename obj)))
    (mapcar
      '(lambda (att) (list (vla-get-tagstring att) (vla-get-textstring att)))
      (vlax-invoke obj 'getattributes)
    )
  )
)

; (BlockMode1_FormatAttributes '(("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))) => (("00-12-11" "Notes") (1 33.7))
(defun BlockMode1_FormatAttributes (lst / val1 val2 val3 val4)
  (if
    (and
      (setq val1 (cadr (assoc "TAG_1" lst)))
      (setq val2 (cadr (assoc "TAG_2" lst)))
      (setq val3 (cadr (assoc "TAG_3" lst)))
      (setq val4 (cadr (assoc "TAG_4" lst)))
    )
    (list (list val1 val2) (list (atoi val4) (atof val3)))
  )
)

; (BlockMode1_MergeAttributes '(("00-12-11" "Notes") (1 44.5)) '((("00-12-11" "Notes") (1 33.7)))) => ((("00-12-11" "Notes") (1 78.2)))
; (BlockMode1_MergeAttributes '(("00-12-11" "Notes") (2 44.5)) '((("00-12-11" "Notes") (1 33.7)))) => ((("00-12-11" "Notes") (1 33.7) (2 44.5)))
; (BlockMode1_MergeAttributes '(("00-11-05" "Notes") (4 89.0)) '((("00-12-11" "Notes") (1 33.7)))) => ((("00-11-05" "Notes") (4 89.0)) (("00-12-11" "Notes") (1 33.7)))
(defun BlockMode1_MergeAttributes (new main / fndMain fndSub)
  (if (setq fndMain (assoc (car new) main))
    (if (setq fndSub (assoc (caadr new) fndMain))
      (subst
        (subst (list (car fndSub) (+ (cadr fndSub) (cadadr new))) fndSub fndMain)
        fndMain
        main
      )
      (subst
        (append fndMain (cdr new))
        fndMain
        main
      )
    )
    (cons new main)
  )
)

(defun BlockMode1_MakeCsvList (main intHeaderLst) ; Note: return value of rtos depends on DIMZIN.
  (cons
    (append '("\"Block Mode_1\"" "\"Description\"") (mapcar 'itoa intHeaderLst) '("\"Sum of all zones\""))
    (mapcar
      '(lambda (sub)
        ; Format sub:
        ; (("00-25-06" "Notes") (5 64.0) (1 15.0))
        (append
          (list
            (strcat "\"" (caar sub) "\"")
            (strcat "\"" (cadar sub) "\"")
          )
          (mapcar
            '(lambda (i / fnd)
              (cond
                ((setq fnd (cadr (assoc i sub)))
                  (rtos fnd 2 1)
                )
                ("")
              )
            )
            intHeaderLst
          )
          (list (rtos (apply '+ (mapcar 'cadr (cdr sub))) 2 1))
        )
      )
      main
    )
  )
)

(defun c:Test ( / fnm lst main ss intHeaderLst)
  (if
    (and
      (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (setq lst
        (mapcar
          (lambda (enm) (BlockMode1_FormatAttributes (BlockMode1_GetAttributes enm)))
          (KGA_Conv_Pickset_To_EnameList ss)
        )
      )
      (or
        (not (vl-position nil lst))
        (prompt "\nError: set contains blocks with wrong names and/or blocks with missing attributes ")
      )
      (setq fnm (getfiled "CSV file" (getvar 'dwgprefix) "csv" 5))
    )
    (progn
      (foreach new lst
        (setq main (BlockMode1_MergeAttributes new main))
      )
      (setq main (vl-sort main '(lambda (a b) (< (caar a) (caar b)))))
      ; Format main:
      ; (
      ;   (("00-11-05" "Notes") (4 89.0))
      ;   (("00-12-11" "Notes") (1 78.2))
      ;   (("00-25-06" "Notes") (5 64.0) (1 15.0))
      ; )
      (foreach i (mapcar 'car (apply 'append (mapcar 'cdr main)))
        (if (not (vl-position i intHeaderLst))
          (setq intHeaderLst (cons i intHeaderLst))
        )
      )
      (setq intHeaderLst (vl-sort intHeaderLst '<))
      (KGA_Data_FileWrite
        fnm
        (mapcar
          '(lambda (sub) (KGA_String_Join sub ","))
          (BlockMode1_MakeCsvList main intHeaderLst)
        )
      )
      (princ "\nDone! ")
    )
  )
  (princ)
)

 

[Steven P]

you could try Lee Macs atribute extractor: http://www.lee-mac.com/macatt.html

after that its just mamipulating  he data in excel - I wuld have 2 spreadsheets, save the extracted data as a s[ecific name and use lookups in the other refering to the first

[savinirsb4u]

Hi Roy, I am getting the following error when testing the lisp.

; error: bad function: #<SUBR @000001cb22b41bb0 -lambda->

 

I am unable to understand the error to fix it from my end. I  am greatly appreciated  your efforts for writing the script as I have approached some other forums as well but didn't get luck from any members. Please help me out to solve the issue. Thanks in advance

 

 

[Tharwat]

43 minutes ago, savinirsb4u said:

I am unable to understand the error to fix it from my end.......

Just add a QUOTE before the lambda function as follows:

 (mapcar
       '(lambda (enm) ;; add QUOTE ( ' ) before tha lambda function 
          (BlockMode1_FormatAttributes (BlockMode1_GetAttributes enm)))
          (KGA_Conv_Pickset_To_EnameList ss)
        )

 

[Roy_043]

Thanks @Tharwat. BricsCAD accepts the missing quote.

[savinirsb4u]

Hi thank you very much guys. 

Lisp is perfectly working for me. I am very curious about this lisp and willing to learn more on scripting.
If possible can you do one more favour for me if possible. 

I have 3 more additional requests with this script.
1) Need to select all the blocks with block name "Block Mode_1" without selecting manually. 
2) Instead of choosing the CSV path can we get the excel in the same drawing file path with drawing name
3) Really sorry for this 3rd question. Can we remove TAG_2 details from selection set. (No need to export Tag_2 Values into excel)
 

[Roy_043]

Revised code:

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

; Function returns nil if the effective name is wrong.
; (BlockMode1_GetAttributes (car (entsel))) => (("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))
(defun BlockMode1_GetAttributes (enm / obj)
  (setq obj (vlax-ename->vla-object enm))
  (if (= "BLOCK MODE_1" (strcase (vla-get-effectivename obj)))
    (mapcar
      '(lambda (att) (list (vla-get-tagstring att) (vla-get-textstring att)))
      (vlax-invoke obj 'getattributes)
    )
  )
)

; Function returns nil if attributes are missing, the "TAG_3" value is not a real or the "TAG_4" value is not an integer.
; (BlockMode1_FormatAttributes '(("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))) => (("00-12-11") (1 33.7))
(defun BlockMode1_FormatAttributes (lst / val1 val3 val4)
  (if
    (and
      (setq val1 (cadr (assoc "TAG_1" lst)))
      (setq val3 (cadr (assoc "TAG_3" lst)))
      (not (wcmatch val3 "*[~-.0-9]*,`.,*`.*`.*,-,?*-*"))
      (setq val4 (cadr (assoc "TAG_4" lst)))
      (not (wcmatch val4 "*[~-0-9]*,-,?*-*"))
    )
    (list (list val1) (list (atoi val4) (atof val3)))
  )
)

; (BlockMode1_MergeAttributes '(("00-12-11") (1 44.5)) '((("00-12-11") (1 33.7)))) => ((("00-12-11") (1 78.2)))
; (BlockMode1_MergeAttributes '(("00-12-11") (2 44.5)) '((("00-12-11") (1 33.7)))) => ((("00-12-11") (1 33.7) (2 44.5)))
; (BlockMode1_MergeAttributes '(("00-11-05") (4 89.0)) '((("00-12-11") (1 33.7)))) => ((("00-11-05") (4 89.0)) (("00-12-11") (1 33.7)))
(defun BlockMode1_MergeAttributes (new main / fndMain fndSub)
  (if (setq fndMain (assoc (car new) main))
    (if (setq fndSub (assoc (caadr new) fndMain))
      (subst
        (subst (list (car fndSub) (+ (cadr fndSub) (cadadr new))) fndSub fndMain)
        fndMain
        main
      )
      (subst
        (append fndMain (cdr new))
        fndMain
        main
      )
    )
    (cons new main)
  )
)

(defun BlockMode1_MakeCsvList (main intHeaderLst) ; Note: return value of rtos depends on DIMZIN.
  (cons
    (append '("\"Block Mode_1\"") (mapcar 'itoa intHeaderLst) '("\"Sum of all zones\""))
    (mapcar
      '(lambda (sub)
        ; Format sub:
        ; (("00-25-06") (5 64.0) (1 15.0))
        (append
          (list (strcat "\"" (caar sub) "\""))
          (mapcar
            '(lambda (i / fnd)
              (cond
                ((setq fnd (cadr (assoc i sub)))
                  (rtos fnd 2 1)
                )
                ("")
              )
            )
            intHeaderLst
          )
          (list (rtos (apply '+ (mapcar 'cadr (cdr sub))) 2 1))
        )
      )
      main
    )
  )
)

(defun c:Test ( / fnm lst main ss intHeaderLst)
  (if
    (and
      (setq ss (ssget "_X" '((0 . "INSERT") (2 . "Block Mode_1,`**") (66 . 1))))
      (setq lst
        (mapcar
          '(lambda (enm)
            (BlockMode1_FormatAttributes
              (vl-remove nil (BlockMode1_GetAttributes enm)) ; BlockMode1_GetAttributes returns nil if effective name is worng.
            )
          )
          (KGA_Conv_Pickset_To_EnameList ss)
        )
      )
      (or
        (not (vl-position nil lst))
        (prompt "\nError: dwg contains \"Block Mode_1\" blocks with missing or wrong attributes ")
      )
      (or
        (= 1 (getvar 'dwgtitled))
        (prompt "\nError: dwg has not been saved ")
      )
      (setq fnm
        (strcat
          (getvar 'dwgprefix)
          (vl-filename-base (getvar 'dwgname))
          ".csv"
        )
      )
    )
    (progn
      (foreach new lst
        (setq main (BlockMode1_MergeAttributes new main))
      )
      (setq main (vl-sort main '(lambda (a b) (< (caar a) (caar b)))))
      ; Format main:
      ; (
      ;   (("00-11-05") (4 89.0))
      ;   (("00-12-11") (1 78.2))
      ;   (("00-25-06") (5 64.0) (1 15.0))
      ; )
      (foreach i (mapcar 'car (apply 'append (mapcar 'cdr main)))
        (if (not (vl-position i intHeaderLst))
          (setq intHeaderLst (cons i intHeaderLst))
        )
      )
      (setq intHeaderLst (vl-sort intHeaderLst '<))
      (KGA_Data_FileWrite
        fnm
        (mapcar
          '(lambda (sub) (KGA_String_Join sub ","))
          (BlockMode1_MakeCsvList main intHeaderLst)
        )
      )
      (princ "\nDone! ")
    )
  )
  (princ)
)

 

[savinirsb4u]

Awesome Roy..

You made my day.. Thank you very much..

[savinirsb4u]

Hi Roy, can you do one more favour on this script?
Need to rearrange "Sum of all zones column" as a second column.
1st column should be Tag_1 Values & 2nd column should be Sum of all zones column

 

[Roy_043]

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

; Function returns nil if the effective name is wrong.
; (BlockMode1_GetAttributes (car (entsel))) => (("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))
(defun BlockMode1_GetAttributes (enm / obj)
  (setq obj (vlax-ename->vla-object enm))
  (if (= "BLOCK MODE_1" (strcase (vla-get-effectivename obj)))
    (mapcar
      '(lambda (att) (list (vla-get-tagstring att) (vla-get-textstring att)))
      (vlax-invoke obj 'getattributes)
    )
  )
)

; Function returns nil if attributes are missing, the "TAG_3" value is not a real or the "TAG_4" value is not an integer.
; (BlockMode1_FormatAttributes '(("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))) => (("00-12-11") (1 33.7))
(defun BlockMode1_FormatAttributes (lst / val1 val3 val4)
  (if
    (and
      (setq val1 (cadr (assoc "TAG_1" lst)))
      (setq val3 (cadr (assoc "TAG_3" lst)))
      (not (wcmatch val3 "*[~-.0-9]*,`.,*`.*`.*,-,?*-*"))
      (setq val4 (cadr (assoc "TAG_4" lst)))
      (not (wcmatch val4 "*[~-0-9]*,-,?*-*"))
    )
    (list (list val1) (list (atoi val4) (atof val3)))
  )
)

; (BlockMode1_MergeAttributes '(("00-12-11") (1 44.5)) '((("00-12-11") (1 33.7)))) => ((("00-12-11") (1 78.2)))
; (BlockMode1_MergeAttributes '(("00-12-11") (2 44.5)) '((("00-12-11") (1 33.7)))) => ((("00-12-11") (1 33.7) (2 44.5)))
; (BlockMode1_MergeAttributes '(("00-11-05") (4 89.0)) '((("00-12-11") (1 33.7)))) => ((("00-11-05") (4 89.0)) (("00-12-11") (1 33.7)))
(defun BlockMode1_MergeAttributes (new main / fndMain fndSub)
  (if (setq fndMain (assoc (car new) main))
    (if (setq fndSub (assoc (caadr new) fndMain))
      (subst
        (subst (list (car fndSub) (+ (cadr fndSub) (cadadr new))) fndSub fndMain)
        fndMain
        main
      )
      (subst
        (append fndMain (cdr new))
        fndMain
        main
      )
    )
    (cons new main)
  )
)

(defun BlockMode1_MakeCsvList (main intHeaderLst) ; Note: return value of rtos depends on DIMZIN.
  (cons
    (append '("\"Block Mode_1\"") (mapcar 'itoa intHeaderLst) '("\"Sum of all zones\""))
    (mapcar
      '(lambda (sub)
        ; Format sub:
        ; (("00-25-06") (5 64.0) (1 15.0))
        (append
          (list (strcat "\"" (caar sub) "\""))
          (list (rtos (apply '+ (mapcar 'cadr (cdr sub))) 2 1))
          (mapcar
            '(lambda (i / fnd)
              (cond
                ((setq fnd (cadr (assoc i sub)))
                  (rtos fnd 2 1)
                )
                ("")
              )
            )
            intHeaderLst
          )
        )
      )
      main
    )
  )
)

(defun c:Test ( / fnm lst main ss intHeaderLst)
  (if
    (and
      (setq ss (ssget "_X" '((0 . "INSERT") (2 . "Block Mode_1,`**") (66 . 1))))
      (setq lst
        (mapcar
          '(lambda (enm)
            (BlockMode1_FormatAttributes
              (vl-remove nil (BlockMode1_GetAttributes enm)) ; BlockMode1_GetAttributes returns nil if effective name is worng.
            )
          )
          (KGA_Conv_Pickset_To_EnameList ss)
        )
      )
      (or
        (not (vl-position nil lst))
        (prompt "\nError: dwg contains \"Block Mode_1\" blocks with missing or wrong attributes ")
      )
      (or
        (= 1 (getvar 'dwgtitled))
        (prompt "\nError: dwg has not been saved ")
      )
      (setq fnm
        (strcat
          (getvar 'dwgprefix)
          (vl-filename-base (getvar 'dwgname))
          ".csv"
        )
      )
    )
    (progn
      (foreach new lst
        (setq main (BlockMode1_MergeAttributes new main))
      )
      (setq main (vl-sort main '(lambda (a b) (< (caar a) (caar b)))))
      ; Format main:
      ; (
      ;   (("00-11-05") (4 89.0))
      ;   (("00-12-11") (1 78.2))
      ;   (("00-25-06") (5 64.0) (1 15.0))
      ; )
      (foreach i (mapcar 'car (apply 'append (mapcar 'cdr main)))
        (if (not (vl-position i intHeaderLst))
          (setq intHeaderLst (cons i intHeaderLst))
        )
      )
      (setq intHeaderLst (vl-sort intHeaderLst '<))
      (KGA_Data_FileWrite
        fnm
        (mapcar
          '(lambda (sub) (KGA_String_Join sub ","))
          (BlockMode1_MakeCsvList main intHeaderLst)
        )
      )
      (princ "\nDone! ")
    )
  )
  (princ)
)

 

[savinirsb4u]

Hi Roy,

Thank you very much for the revised code.
I have modified some part from the script as below to get the correct headers position: 

(append '("\"Block Mode_1\"") '("\"Sum of all zones\"") (mapcar 'itoa intHeaderLst) )

One more final request in this tread.

Can I get a new lisp to get results in the below format(Only 2 columns required): 
("\"Block Mode_1\"") '("\"Sum of all zones\"")

[Roy_043]

Revised code below. The command functions are called SpecialExtractWithDetails and SpecialExtractNoDetails.

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Data_FileWrite (fnm lst / ptr)
  (if (setq ptr (open fnm "w"))
    (progn
      (write-line (KGA_String_Join lst "\n") ptr)
      (close ptr)
      T
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

; Function returns nil if the effective name is wrong.
; (BlockMode1_GetAttributes (car (entsel))) => (("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))
(defun BlockMode1_GetAttributes (enm / obj)
  (setq obj (vlax-ename->vla-object enm))
  (if (= "BLOCK MODE_1" (strcase (vla-get-effectivename obj)))
    (mapcar
      '(lambda (att) (list (vla-get-tagstring att) (vla-get-textstring att)))
      (vlax-invoke obj 'getattributes)
    )
  )
)

; Function returns nil if attributes are missing, the "TAG_3" value is not a real or the "TAG_4" value is not an integer.
; (BlockMode1_FormatAttributes '(("TAG_1" "00-12-11") ("TAG_2" "Notes") ("TAG_3" "33.7") ("TAG_4" "01"))) => (("00-12-11") (1 33.7))
(defun BlockMode1_FormatAttributes (lst / val1 val3 val4)
  (if
    (and
      (setq val1 (cadr (assoc "TAG_1" lst)))
      (setq val3 (cadr (assoc "TAG_3" lst)))
      (not (wcmatch val3 "*[~-.0-9]*,`.,*`.*`.*,-,?*-*"))
      (setq val4 (cadr (assoc "TAG_4" lst)))
      (not (wcmatch val4 "*[~-0-9]*,-,?*-*"))
    )
    (list (list val1) (list (atoi val4) (atof val3)))
  )
)

; (BlockMode1_MergeAttributes '(("00-12-11") (1 44.5)) '((("00-12-11") (1 33.7)))) => ((("00-12-11") (1 78.2)))
; (BlockMode1_MergeAttributes '(("00-12-11") (2 44.5)) '((("00-12-11") (1 33.7)))) => ((("00-12-11") (1 33.7) (2 44.5)))
; (BlockMode1_MergeAttributes '(("00-11-05") (4 89.0)) '((("00-12-11") (1 33.7)))) => ((("00-11-05") (4 89.0)) (("00-12-11") (1 33.7)))
(defun BlockMode1_MergeAttributes (new main / fndMain fndSub)
  (if (setq fndMain (assoc (car new) main))
    (if (setq fndSub (assoc (caadr new) fndMain))
      (subst
        (subst (list (car fndSub) (+ (cadr fndSub) (cadadr new))) fndSub fndMain)
        fndMain
        main
      )
      (subst
        (append fndMain (cdr new))
        fndMain
        main
      )
    )
    (cons new main)
  )
)

; If intHeaderLst is nil zone details will be omitted.
(defun BlockMode1_MakeCsvList (main intHeaderLst) ; Note: return value of rtos depends on DIMZIN.
  (cons
    (append '("\"Block Mode_1\"") '("\"Sum of all zones\"") (mapcar 'itoa intHeaderLst))
    (mapcar
      '(lambda (sub)
        ; Format sub:
        ; (("00-25-06") (5 64.0) (1 15.0))
        (append
          (list (strcat "\"" (caar sub) "\""))
          (list (rtos (apply '+ (mapcar 'cadr (cdr sub))) 2 1))
          (mapcar
            '(lambda (i / fnd)
              (cond
                ((setq fnd (cadr (assoc i sub)))
                  (rtos fnd 2 1)
                )
                ("")
              )
            )
            intHeaderLst
          )
        )
      )
      main
    )
  )
)

(defun c:SpecialExtractWithDetails ( / fnm lst main ss intHeaderLst)
  (if
    (and
      (setq ss (ssget "_X" '((0 . "INSERT") (2 . "Block Mode_1,`**") (66 . 1))))
      (setq lst
        (mapcar
          '(lambda (enm)
            (BlockMode1_FormatAttributes
              (vl-remove nil (BlockMode1_GetAttributes enm)) ; BlockMode1_GetAttributes returns nil if effective name is worng.
            )
          )
          (KGA_Conv_Pickset_To_EnameList ss)
        )
      )
      (or
        (not (vl-position nil lst))
        (prompt "\nError: dwg contains \"Block Mode_1\" blocks with missing or wrong attributes ")
      )
      (or
        (= 1 (getvar 'dwgtitled))
        (prompt "\nError: dwg has not been saved ")
      )
      (setq fnm
        (strcat
          (getvar 'dwgprefix)
          (vl-filename-base (getvar 'dwgname))
          ".csv"
        )
      )
    )
    (progn
      (foreach new lst
        (setq main (BlockMode1_MergeAttributes new main))
      )
      (setq main (vl-sort main '(lambda (a b) (< (caar a) (caar b)))))
      ; Format main:
      ; (
      ;   (("00-11-05") (4 89.0))
      ;   (("00-12-11") (1 78.2))
      ;   (("00-25-06") (5 64.0) (1 15.0))
      ; )
      (foreach i (mapcar 'car (apply 'append (mapcar 'cdr main)))
        (if (not (vl-position i intHeaderLst))
          (setq intHeaderLst (cons i intHeaderLst))
        )
      )
      (setq intHeaderLst (vl-sort intHeaderLst '<))
      (KGA_Data_FileWrite
        fnm
        (mapcar
          '(lambda (sub) (KGA_String_Join sub ","))
          (BlockMode1_MakeCsvList main intHeaderLst)
        )
      )
      (princ "\nDone! ")
    )
  )
  (princ)
)

(defun c:SpecialExtractNoDetails ( / fnm lst main ss)
  (if
    (and
      (setq ss (ssget "_X" '((0 . "INSERT") (2 . "Block Mode_1,`**") (66 . 1))))
      (setq lst
        (mapcar
          '(lambda (enm)
            (BlockMode1_FormatAttributes
              (vl-remove nil (BlockMode1_GetAttributes enm)) ; BlockMode1_GetAttributes returns nil if effective name is worng.
            )
          )
          (KGA_Conv_Pickset_To_EnameList ss)
        )
      )
      (or
        (not (vl-position nil lst))
        (prompt "\nError: dwg contains \"Block Mode_1\" blocks with missing or wrong attributes ")
      )
      (or
        (= 1 (getvar 'dwgtitled))
        (prompt "\nError: dwg has not been saved ")
      )
      (setq fnm
        (strcat
          (getvar 'dwgprefix)
          (vl-filename-base (getvar 'dwgname))
          ".csv"
        )
      )
    )
    (progn
      (foreach new lst
        (setq main (BlockMode1_MergeAttributes new main))
      )
      (setq main (vl-sort main '(lambda (a b) (< (caar a) (caar b)))))
      ; Format main:
      ; (
      ;   (("00-11-05") (4 89.0))
      ;   (("00-12-11") (1 78.2))
      ;   (("00-25-06") (5 64.0) (1 15.0))
      ; )
      (KGA_Data_FileWrite
        fnm
        (mapcar
          '(lambda (sub) (KGA_String_Join sub ","))
          (BlockMode1_MakeCsvList main nil)
        )
      )
      (princ "\nDone! ")
    )
  )
  (princ)
)

 

[savinirsb4u]

Thank you Roy.. Perfectly working..

 

I have write a bit similar code but I got stuck to manage the duplicates of Tag_1 Values and merging the quantities into excel. Please find the below code of mine. And advise which steps I need to add to merge the attributes and sum the values in my script. This is just for my curiosity only. 

 

(defun c:BlockEXT( / e x)
(vl-load-com)
(if (ssget "_x"'((0 . "INSERT") (2 . "Block Mode_1,`*U*") (66 . 1)))
(progn
(if
(and
(setq file(open (strcat (getvar "dwgprefix")(vl-filename-base(getvar "dwgname")) "_EXTRACT.csv") "w"))
(setq dta (ssget "_x"'((0 . "INSERT") (2 . "Block Mode_1,`*U*") (66 . 1))))
)
(progn
(write-line "Block CODES,QUANTITY" file)
(setq cntr (- (sslength dta) 1))
(while 
(>= cntr 0)
(setq 	en(ssname dta cntr))
(setq 	enlist(entget en))
(setq x (entget en))
(setq at (entnext en))
(setq ax (entget at))


(if
(wcmatch (cdr (assoc 2 ax)) "TAG_1")
(progn
(setq at (entnext en))(setq ax (entget at))
(while
(/= "SEQEND" (cdr (assoc 0 ax)) )
(cond
((= "TAG_1" (cdr (assoc 2 ax)))
(setq v1(cdr (assoc 1 ax)))
)

((= "TAG_3" (cdr (assoc 2 ax)) )
(setq v2 (cdr (assoc 1 ax)) ))


);cond
(setq at (entnext at)ax (entget at))

);while

(write-line (strcat (vl-princ-to-string v1) ","  v2) file)

);Progn
);if
(setq cntr(- cntr 1))
);while

)
(close file)
)
(setq v1 nil)
(setq v2 nil)

(close file)

(alert "CODES Extracted\n\n\n\n\Please find the Excel in the current drawing Path")
(STARTAPP "EXPLORER.EXE" (GETVAR"DWGPREFIX"))
))
(princ))

 

[Roy_043]

I am not going to comment on your code. But suggest you get better acquainted with several list related techniques.

[savinirsb4u]

Its ok Roy.. I am not an advanced programmer to write the scripts in a shorter way. 

But Many thanks for your valuable support to extract my blocks in specified format. Iam  Really Appreciated for your efforts on helping me.