Jump to content

extract attribute selected in excel

Michel

By Michel
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Michel Rookie

Michel

Posted
Posted

Hi, I am Michel

 

Can you kindly to help me to. I need a lisp for a cable routing. 

I have just a block consist of 3 attributes (TAG, SRTP, MVZ). I need to extract each relating value in separate column in excel. For example, if I select 5 blocks in drawing, I need to have 5 columns, each column has only 3 rows (3 attributes) and the possibility to have different rows for different electric cables in same file.

 

Thank you in advance

Michel

richiesta.xlsx

devitg Experienced

devitg

Posted
Posted (edited)
2 hours ago, Michel said:

Hi, I am Michel

 

Can you kindly to help me to. I need a lisp for a cable routing. 

I have just a block consist of 3 attributes (TAG, SRTP, MVZ). I need to extract each relating value in separate column in excel. For example, if I select 5 blocks in drawing, I need to have 5 columns, each column has only 3 rows (3 attributes) and the possibility to have different rows for different electric cables in same file.

 

Thank you in advance

Michel

richiesta.xlsx 12.81 kB · 0 downloads

For better understanding, and  maybe get further help, please upload such sample.dwg 

 

Or do a ATTOUT , it will make a CSV file you can open with XLS 

 

Edited by devitg
add use attout
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Did you Google there is so many references to Block atts to excel. devitg has given you one.

 

Google "Extract attributes to excel Autocad" 

 

One option is make a table of the results wanted as part of drawing, then export table to excel.

Edited by BIGAL
Michel Rookie

Michel

Posted
  • Author
Posted

Hi I upload an example. 

I would like extract block's attributes by selection on screen of a sequence of blocks.

test.dwg test.xlsx

exceed Proficient

exceed

Posted
Posted (edited)

http://www.lee-mac.com/attributefunctions.html

If you're lost way in Lisp, see the Lee Mac. he will point you to the right path

 

with this code, you can get your block attributes in list. 

It is not difficult to extract this into Excel.

  

;; Extracting Block Attributes to Excel - 2022-04-08 exceed
;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/

(vl-load-com)
(defun c:EXATT ( / blk *error* ss ssl index ename blk lst rclist answer )
  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\n Error: " msg))
    )
    (princ)
  )
(setq rclist (ex:ECADR))
(setq r (car rclist))
(setq r0 r)
(setq c (cadr rclist))
(setq c0 c)

(setq answer (getstring "\n enter here? ( space-bar(yes) / esc(no) )"))

(setq ss (ssget '((0 . "insert")) ) )
(setq ssl (sslength ss))
(setq index 0)
(repeat ssl
   (setq ename (ssname ss index))
   (setq blk (vlax-ename->vla-object ename))
   (setq lst (LM:vl-getattributevalues blk))
   (setq lstlen (length lst))
   (setq index2 0)
   (ex:ecsel r c)
   (ex:ecput (strcat "BLOCK" (vl-princ-to-string (+ index 1))))
   (setq r (+ r 1))
      (repeat lstlen
        (setq sublst (nth index2 lst))
        (setq atxt (car sublst))
        (setq btxt (cdr sublst))
        (ex:ecsel r c)
        (ex:ecput btxt)
        (setq r (+ r 1))
        (setq index2 (+ index2 1))
      );end of repeat2
   ;(princ lst)
   (setq r (- (- r index2) 1))
   (setq c (+ c 1))
   (setq index (+ index 1))
);end of repeat
(setq r r0)
(ex:ecsel r c)
(princ)
)


;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues ( blk )
    (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)


(defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))


 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 ;(princ " ( in address format ")
 ;(princ addr)
 ;(princ " )")


 (setq rng (vlax-get-property acsheet 'Range addr))
 (vlax-invoke rng 'Select)



 (setvar "cmdecho" 1)
 (princ)
)



(defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq textstring2 (strcat "'" textstring))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     ;(princ "c1 - ")
     ;(princ c1)
     ;(princ "c2 - ")
     ;(princ c2)
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (setq c (+ c 1))

 (vlax-put-property cell 'item r c textstring2)
 (setvar "cmdecho" 1)
 (princ)
)




(defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 )
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      (princ "\n workbook name - ")
      (princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (princ "\n active sheet now - ")
 (princ acsheetname)

 (princ "\n your selected cell is - Row ")
 (princ r)
 (princ ", Column ")
 (princ c)

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (princ " ( in address format ")
 (princ addr)
 (princ " )")

 (setq c (+ c 1))
 (list r c)



)

 

like this ?

 

test.gif

 

 

 

command : EXATT

 

 

 

 

 

 

Edited by exceed
  • Like 1
  • Thanks 1
Michel Rookie

Michel

Posted
  • Author
Posted
6 hours ago, exceed said:

http://www.lee-mac.com/attributefunctions.html

If you're lost way in Lisp, see the Lee Mac. he will point you to the right path

 

with this code, you can get your block attributes in list. 

It is not difficult to extract this into Excel.

  

;; Extracting Block Attributes to Excel - 2022-04-08 exceed
;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/

(vl-load-com)
(defun c:test ( / blk *error* ss ssl index ename blk lst rclist answer )
  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\n Error: " msg))
    )
    (princ)
  )
(setq rclist (ex:ECADR))
(setq r (car rclist))
(setq r0 r)
(setq c (cadr rclist))
(setq c0 c)

(setq answer (getstring "\n enter here? ( space-bar(yes) / esc(no) )"))

(setq ss (ssget '((0 . "insert")) ) )
(setq ssl (sslength ss))
(setq index 0)
(repeat ssl
   (setq ename (ssname ss index))
   (setq blk (vlax-ename->vla-object ename))
   (setq lst (LM:vl-getattributevalues blk))
   (setq lstlen (length lst))
   (setq index2 0)
   (ex:ecsel r c)
   (ex:ecput (strcat "BLOCK" (vl-princ-to-string (+ index 1))))
   (setq r (+ r 1))
      (repeat lstlen
        (setq sublst (nth index2 lst))
        (setq atxt (car sublst))
        (setq btxt (cdr sublst))
        (ex:ecsel r c)
        (ex:ecput btxt)
        (setq r (+ r 1))
        (setq index2 (+ index2 1))
      );end of repeat2
   ;(princ lst)
   (setq r (- (- r index2) 1))
   (setq c (+ c 1))
   (setq index (+ index 1))
);end of repeat
(setq r r0)
(ex:ecsel r c)
(princ)
)


;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues ( blk )
    (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)


(defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))


 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 ;(princ " ( in address format ")
 ;(princ addr)
 ;(princ " )")


 (setq rng (vlax-get-property acsheet 'Range addr))
 (vlax-invoke rng 'Select)



 (setvar "cmdecho" 1)
 (princ)
)



(defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq textstring2 (strcat "'" textstring))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     ;(princ "c1 - ")
     ;(princ c1)
     ;(princ "c2 - ")
     ;(princ c2)
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (setq c (+ c 1))

 (vlax-put-property cell 'item r c textstring2)
 (setvar "cmdecho" 1)
 (princ)
)




(defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 )
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      (princ "\n workbook name - ")
      (princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (princ "\n active sheet now - ")
 (princ acsheetname)

 (princ "\n your selected cell is - Row ")
 (princ r)
 (princ ", Column ")
 (princ c)

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (princ " ( in address format ")
 (princ addr)
 (princ " )")

 (setq c (+ c 1))
 (list r c)



)

 

like this ?

 

test.gif

 

 

 

command : EXATT

 

 

 

 

 

 

Hi, thank you, it is perfect. Is it possible to delet cmd "enter here? ( space-bar(yes) / esc(no) )" and added the cmd "type tagname of cable"? first column  should be dedicated for cable ID. I would like to have different rows for different electric cables in same file. Please see attached

test.xlsx

exceed Proficient

exceed

Posted
Posted (edited)
3 hours ago, Michel said:

Hi, thank you, it is perfect. Is it possible to delet cmd "enter here? ( space-bar(yes) / esc(no) )" and added the cmd "type tagname of cable"? first column  should be dedicated for cable ID. I would like to have different rows for different electric cables in same file. Please see attached

test.xlsx 12.69 kB · 1 download

2022-04-08%2019;36;29.gif

 

  

;; Extracting Block Attributes to Excel - 2022-04-08 exceed
;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/

(vl-load-com)
(defun c:EXATT ( / blk *error* ss ssl index ename blk lst rclist answer r c r0 c0 lstlen index2 sublst atxt btxt )
  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\n Error: " msg))
    )
    (princ)
  )
(setq rclist (ex:ECADR))
(setq r (car rclist))
(setq r0 r)
(setq c (cadr rclist))
(setq c0 c)

(setq answer (getstring t "\n If you would like to enter here, please enter the CABLE TAG NAME : "))
; if the cable name has no space bar. replace this line with below. it will make it work by space bar. 
; (setq answer (getstring "\n If you would like to enter here, please enter the CABLE TAG NAME : "))


   (setq ss (ssget '((0 . "insert")) ) )
   (setq ssl (sslength ss))
   (setq index 0)
   (ex:ecsel r c)
   (ex:ecput answer)

   (setq c (+ c 1))
(repeat ssl
   (setq ename (ssname ss index))
   (setq blk (vlax-ename->vla-object ename))
   (setq lst (LM:vl-getattributevalues blk))
   (setq lstlen (length lst))
   (setq index2 0)
      (repeat lstlen
        (setq sublst (nth index2 lst))
        (setq atxt (car sublst))
        (setq btxt (cdr sublst))
        (ex:ecsel r c)
        (ex:ecput btxt)
        (setq r (+ r 1))
        (setq index2 (+ index2 1))
      );end of repeat2
   ;(princ lst)
   (setq r (- r index2))
   (setq c (+ c 1))
   (setq index (+ index 1))
);end of repeat
;(setq r r0)
(setq r (+ r index2))
(setq c c0)
(ex:ecsel r c)
(princ)
)


;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues ( blk )
    (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)


(defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))


 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 ;(princ " ( in address format ")
 ;(princ addr)
 ;(princ " )")


 (setq rng (vlax-get-property acsheet 'Range addr))
 (vlax-invoke rng 'Select)



 (setvar "cmdecho" 1)
 (princ)
)



(defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq textstring2 (strcat "'" textstring))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     ;(princ "c1 - ")
     ;(princ c1)
     ;(princ "c2 - ")
     ;(princ c2)
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (setq c (+ c 1))

 (vlax-put-property cell 'item r c textstring2)
 (setvar "cmdecho" 1)
 (princ)
)




(defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 )
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      (princ "\n workbook name - ")
      (princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (princ "\n active sheet now - ")
 (princ acsheetname)

 (princ "\n your selected cell is - Row ")
 (princ r)
 (princ ", Column ")
 (princ c)

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (princ " ( in address format ")
 (princ addr)
 (princ " )")

 (setq c (+ c 1))
 (list r c)



)

 

like this?

There was no cable number in the drawing, so I didn't make it.

but, I think you'll want something like that, so I made a simple response with getstring, not getkword Y/N.

 

In the first row, as in your example, the number of blocks can be different for each 1 cable (= 1 extraction)

so it is easier to write it down in Excel than to find the maximum number of blocks in Lisp.

 

+ there's no MVZ value in your example dwg also.

Edited by exceed
  • Thanks 1
Michel Rookie

Michel

Posted
  • Author
Posted
On 4/8/2022 at 12:40 PM, exceed said:

2022-04-08%2019;36;29.gif

 

  

;; Extracting Block Attributes to Excel - 2022-04-08 exceed
;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/

(vl-load-com)
(defun c:EXATT ( / blk *error* ss ssl index ename blk lst rclist answer r c r0 c0 lstlen index2 sublst atxt btxt )
  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\n Error: " msg))
    )
    (princ)
  )
(setq rclist (ex:ECADR))
(setq r (car rclist))
(setq r0 r)
(setq c (cadr rclist))
(setq c0 c)

(setq answer (getstring t "\n If you would like to enter here, please enter the CABLE TAG NAME : "))
; if the cable name has no space bar. replace this line with below. it will make it work by space bar. 
; (setq answer (getstring "\n If you would like to enter here, please enter the CABLE TAG NAME : "))


   (setq ss (ssget '((0 . "insert")) ) )
   (setq ssl (sslength ss))
   (setq index 0)
   (ex:ecsel r c)
   (ex:ecput answer)

   (setq c (+ c 1))
(repeat ssl
   (setq ename (ssname ss index))
   (setq blk (vlax-ename->vla-object ename))
   (setq lst (LM:vl-getattributevalues blk))
   (setq lstlen (length lst))
   (setq index2 0)
      (repeat lstlen
        (setq sublst (nth index2 lst))
        (setq atxt (car sublst))
        (setq btxt (cdr sublst))
        (ex:ecsel r c)
        (ex:ecput btxt)
        (setq r (+ r 1))
        (setq index2 (+ index2 1))
      );end of repeat2
   ;(princ lst)
   (setq r (- r index2))
   (setq c (+ c 1))
   (setq index (+ index 1))
);end of repeat
;(setq r r0)
(setq r (+ r index2))
(setq c c0)
(ex:ecsel r c)
(princ)
)


;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues ( blk )
    (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)


(defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))


 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 ;(princ " ( in address format ")
 ;(princ addr)
 ;(princ " )")


 (setq rng (vlax-get-property acsheet 'Range addr))
 (vlax-invoke rng 'Select)



 (setvar "cmdecho" 1)
 (princ)
)



(defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq textstring2 (strcat "'" textstring))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     ;(princ "c1 - ")
     ;(princ c1)
     ;(princ "c2 - ")
     ;(princ c2)
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (setq c (+ c 1))

 (vlax-put-property cell 'item r c textstring2)
 (setvar "cmdecho" 1)
 (princ)
)




(defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 )
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      (princ "\n workbook name - ")
      (princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (princ "\n active sheet now - ")
 (princ acsheetname)

 (princ "\n your selected cell is - Row ")
 (princ r)
 (princ ", Column ")
 (princ c)

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (princ " ( in address format ")
 (princ addr)
 (princ " )")

 (setq c (+ c 1))
 (list r c)



)

 

like this?

There was no cable number in the drawing, so I didn't make it.

but, I think you'll want something like that, so I made a simple response with getstring, not getkword Y/N.

 

In the first row, as in your example, the number of blocks can be different for each 1 cable (= 1 extraction)

so it is easier to write it down in Excel than to find the maximum number of blocks in Lisp.

 

+ there's no MVZ value in your example dwg also.

Thank you very much. It is perfect.

  • Like 1
  • 4 months later...
nekonihonjin Newbie

nekonihonjin

Posted
Posted
On 4/8/2022 at 4:40 AM, exceed said:

2022-04-08%2019;36;29.gif

 

  

;; Extracting Block Attributes to Excel - 2022-04-08 exceed
;; https://www.cadtutor.net/forum/topic/74793-extract-attribute-selected-in-excel/

(vl-load-com)
(defun c:EXATT ( / blk *error* ss ssl index ename blk lst rclist answer r c r0 c0 lstlen index2 sublst atxt btxt )
  (defun *error* ( msg )
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\n Error: " msg))
    )
    (princ)
  )
(setq rclist (ex:ECADR))
(setq r (car rclist))
(setq r0 r)
(setq c (cadr rclist))
(setq c0 c)

(setq answer (getstring t "\n If you would like to enter here, please enter the CABLE TAG NAME : "))
; if the cable name has no space bar. replace this line with below. it will make it work by space bar. 
; (setq answer (getstring "\n If you would like to enter here, please enter the CABLE TAG NAME : "))


   (setq ss (ssget '((0 . "insert")) ) )
   (setq ssl (sslength ss))
   (setq index 0)
   (ex:ecsel r c)
   (ex:ecput answer)

   (setq c (+ c 1))
(repeat ssl
   (setq ename (ssname ss index))
   (setq blk (vlax-ename->vla-object ename))
   (setq lst (LM:vl-getattributevalues blk))
   (setq lstlen (length lst))
   (setq index2 0)
      (repeat lstlen
        (setq sublst (nth index2 lst))
        (setq atxt (car sublst))
        (setq btxt (cdr sublst))
        (ex:ecsel r c)
        (ex:ecput btxt)
        (setq r (+ r 1))
        (setq index2 (+ index2 1))
      );end of repeat2
   ;(princ lst)
   (setq r (- r index2))
   (setq c (+ c 1))
   (setq index (+ index 1))
);end of repeat
;(setq r r0)
(setq r (+ r index2))
(setq c c0)
(ex:ecsel r c)
(princ)
)


;; Get Attribute Values  -  Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )

(defun LM:vl-getattributevalues ( blk )
    (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)


(defun ex:ECSEL ( r c / *error* excelapp workbooks sheets acsheet acsheetname captionname addr rng c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))


 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))

     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 ;(princ " ( in address format ")
 ;(princ addr)
 ;(princ " )")


 (setq rng (vlax-get-property acsheet 'Range addr))
 (vlax-invoke rng 'Select)



 (setvar "cmdecho" 1)
 (princ)
)



(defun ex:ECPUT ( textstring / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring2 textstring c1 c2 c3)
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      ;(princ "\n workbook name - ")
      ;(princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq textstring2 (strcat "'" textstring))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     ;(princ "c1 - ")
     ;(princ c1)
     ;(princ "c2 - ")
     ;(princ c2)
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (setq c (+ c 1))

 (vlax-put-property cell 'item r c textstring2)
 (setvar "cmdecho" 1)
 (princ)
)




(defun ex:ECADR ( / *error* excelapp workbooks sheets acsheet acsheetname accell cell r c captionname addr rng textstring c1 c2 c3 )
 (setvar "cmdecho" 0)
    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (vlax-release-object AcSheet)
        (vlax-release-object Sheets)
        (vlax-release-object Workbooks)
        (vlax-release-object ExcelApp)
        (setvar "cmdecho" 1)
        (princ)
    ) 
 ;BIGAL's ah:chkexcel
 (if (= (setq excelapp (vlax-get-object "Excel.Application") ) nil) ; if open already
     (setq excelapp (vlax-get-or-create-object "Excel.Application"))    
 )
 (if (= (setq acsheet (vlax-get-property ExcelApp 'ActiveSheet)) nil)
    (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add)
 )
 (vlax-put Excelapp "visible" :vlax-true)
 (if (/= (setq captionname (vlax-get-property ExcelApp 'caption)) nil)
    (progn
      (princ "\n workbook name - ")
      (princ captionname)
    );end of progn
 )

 (setq Workbooks (vlax-get-property ExcelApp 'Workbooks))
 (setq Sheets (vlax-get-property ExcelApp 'Sheets))
 (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet))
 (setq acsheetname (vlax-get-property acsheet 'name))
 (setq accell (vlax-get-property ExcelApp 'Activecell))
 (setq cell (vlax-get-property acsheet 'Cells))

 (setq r (vlax-get-property accell 'row))
 (setq c (vlax-get-property accell 'column))

 (princ "\n active sheet now - ")
 (princ acsheetname)

 (princ "\n your selected cell is - Row ")
 (princ r)
 (princ ", Column ")
 (princ c)

 (setq c (- c 1))

 (cond
   ((and (> c -1) (< c 25))
     (setq c1 (+ c 1))
     (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) ))
   );end of cond option 1
   ((and (> c 24) (< c 702))
     (setq c2 (fix (/ c 26)))
     (setq c1 (- c (* c2 26)))
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 2
   ((and (> c 701) (< c 18278))
     (setq c3 (fix (/ c (* 26 26)) ) )
     (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26)))
     (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26)))
     (setq c3 c3)
     (setq c2 c2)
     (setq c1 (+ c1 1))
     (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1)))  (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r)))
   );end of cond option 3
 );end of cond
 (princ " ( in address format ")
 (princ addr)
 (princ " )")

 (setq c (+ c 1))
 (list r c)



)

 

like this?

There was no cable number in the drawing, so I didn't make it.

but, I think you'll want something like that, so I made a simple response with getstring, not getkword Y/N.

 

In the first row, as in your example, the number of blocks can be different for each 1 cable (= 1 extraction)

so it is easier to write it down in Excel than to find the maximum number of blocks in Lisp.

 

+ there's no MVZ value in your example dwg also.

 

 

the post is a bit old, but I hope you can answer me exceed, 
It will be possible to make a modification to your code so that the numerical values are not exported to excel as text? and if you can transpose the rows and columns would be excellent.

Greetings.

TemporaryCAD Contributor

TemporaryCAD

Posted
Posted
On 8/12/2022 at 5:53 PM, nekonihonjin said:

 

 

the post is a bit old, but I hope you can answer me exceed, 
It will be possible to make a modification to your code so that the numerical values are not exported to excel as text? and if you can transpose the rows and columns would be excellent.

Greetings.

 

While not what you're asking, you can do =VALUE(text) in excel to read as a number.  It's probably easier to edit an excel than the lisp.  

  • Like 1
Steven P Grand Master

Steven P

Posted
Posted

Likewise,  it is easier to modify something using the software designed to do that, so modify an excel file with excel, modify data by LISP wthin CAD but don't try to modify excel with CAD or a LISP

 

If I remember right, in LISP you can also use 

(if (numberp TXT)
  (princ "Letters")
  (princ "Numbers")
)

 

something like that, numberp for data within CAD

  • Like 2
nekonihonjin Newbie

nekonihonjin

Posted
Posted
11 hours ago, TemporaryCAD said:

 

While not what you're asking, you can do =VALUE(text) in excel to read as a number.  It's probably easier to edit an excel than the lisp.  

 

it's indeed very easy to convert and transpose in excel, but if I'm gonna do it several times a day, every day, I think in the long term is worth the modification.

 

 

4 hours ago, Steven P said:

Likewise,  it is easier to modify something using the software designed to do that, so modify an excel file with excel, modify data by LISP wthin CAD but don't try to modify excel with CAD or a LISP

 

If I remember right, in LISP you can also use 

(if (numberp TXT)
  (princ "Letters")
  (princ "Numbers")
)

 

something like that, numberp for data within CAD

 

Thanks Steven, gonna try that.

BIGAL Grand Master

BIGAL

Posted
Posted

Trying to remember the difference between 4 and '4 in excel. If a column is numbers then using lisp could reset column, dont ask for code just know could be done. Google excel VBA set column to numbers.

 

image.png.0a75e16596047298f68af8ffa4c72613.png

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.

×
 Share
Go to topic listing
×
×
  • Create New...