Get att prompt and write to excel

[DGRL]

Dear coders

I have a routing that takes the tag and value of attributes inside a block and writes that to excel the way I need it.

Now I need also the prompt but when I add the line (vla-get-promptString x) I get error ; error: bad argument type: listp #<%catch-all-apply-error%>

Here is the routine working ( without the get promptstring)

(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes))
    (vl-catch-all-apply (function (lambda()
   (mapcar (function (lambda (x)
         (cons (vla-get-TagString x)(vla-get-promptString x)
        (vla-get-TextString x))))
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )))))))

I simply thought to add bold part in the code but it gives back the errror
Does any coder here know what to change in order to get this work"?

The whole routine is found below

(vl-load-com)
(defun mip-conv-to-str (dat)(if dat (vl-princ-to-string dat) ""))
(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes))
    (vl-catch-all-apply (function (lambda()
   (mapcar (function (lambda (x)
         (cons (vla-get-TagString x)
        (vla-get-TextString x))))
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )))))))
;|================== XLS ========================================
;* Purpose: Export of the list of data punto_datos in Excell
;*             It is exported to a new leaf of the current book.
;              If the book is not present, it is created
;* Arguments:
;              punto_datos - The list of lists of data (LIST)
;                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
;                            Each list of a kind (Value1 Value2... VlalueN) enters the name in
;                            a separate line in corresponding columns (Value1-A Value2-B and .ò.ä.)
;                  header -  The list (LIST) headings or nil a kind (" Signature A " " Signature B "...)
;                            If header nil, is accepted ("X" "Y" "Z")
;                 Colhide -  The list of alphabetic names of columns to hide or nil - to not hide ("A" "C" "D") - to hide columns A, C, D
;                 Name_list - The name of a new leaf of the active book or nil - is not present
;* Return: nil
;* Usage
;(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Col1" "Col2" "Col3"  "Col4") '("B") "test")   |;
(vl-load-com)
(defun xls ( punto_datos header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))  
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
              *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0 cols nil)
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list) 
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)   
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators")) 
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_êå èñïîëüçîâêòü ñèñòåìêûå óñòêêîâêè
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_ðêçäåëèòåëü äðîáêîé è öåëîé ÷êñòè
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_ðêçäåëèòåëü òûñÿ÷åé
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length punto_datos)(setq iz_listo (car punto_datos))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns)) 
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item))) 
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))   
(vlax-put-property cols 'hidden 1) 
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep) 
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
(defun C:ATTEXP2XL ( / blk pat head ss datalist att_list)
    (princ "\nChoose a block")
    (while (not(setq ss (ssget "_+.:S:E" '((0 . "INSERT")(66 . 1)))))
      (princ "\nWrong... Choose a block with attributes"))
    (setq blk (ssname ss 0) ss nil)
    (setq pat (vl-remove-if-not '(lambda(x)(member (car x) '(0 2 410)))(entget blk)))
    (setq head nil datalist nil)
    (if (setq ss (ssget "_X" pat))
      (progn
      (foreach item (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
        (setq att_list (get-all-atts item))
        (if (null head)(setq head (mapcar 'car att_list)))
        (setq datalist (append datalist (list (mapcar 'cdr att_list))))
      )
      (xls datalist head nil nil)
      )
      )
  (princ)
  )

[_gile]

Hi,

You should have a look at the cons function in the docs.

(cons 1 2) returns a dotted pair (1 . 2)

(cons 1 2 3) raise a "too many arguments" error

if you want a list containg 1, 2 and 3, use the list function:

(list 1 2 3)

But hte calling function will have to care the data is no more a dotted pair (car and cdr) but a 3 items list (car, cadr and caddr).

[DGRL]

Hi

I changed the cons into list and the error is still there

It even changed the output of value from   examp.  14 to (14) ( it adds ( ) to the value

Even when im changing the tag into prompt and leave it to read only 2 things ( prompt and value ) it gives the error
So I think it has more to do with the prompt then with the code

If I look at the lower part of the code

(foreach item (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
        (setq att_list (get-all-atts item))
        (if (null head)(setq head (mapcar 'car att_list)))
        (setq datalist (append datalist (list (mapcar 'cdr att_list))))
      )

I see that the list only contains 2 parts ( the prompt is not even there )

 (setq att_list (get-all-atts item))

This as far as my knowledge is going this should get the TAG PROMPT and VALUE

Since I wanna learn coding I will try to fix is on my own but I need a little push in the right direction 😄

P.s

pls do know that I am not waiting for the solution I am also busy trying to fix it on my own

[DGRL]

hi @_gile

Well I don't get it anymore

When using 2 times TagString it works
When changing it into PromptString I get the error again

(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes))
    (vl-catch-all-apply
 
 (function (lambda() (mapcar (function (lambda (x)
   (list (vla-get-TagString x)(vla-get-TagString x)
    (vla-get-TextString x))))
   (append (vlax-invoke obj 'Getattributes)(vlax-invoke obj 'Getattributes)
  (vlax-invoke obj 'Getconstantattributes)
    )))))))

2 times TAG works but 1 x TAG 1 x prompt and 1 x text gives the error

[_gile]

If you inspect the get-all-atts returned value, you'd see a list of sub-lists which contain (TAG PROMPT VALUE)

This done, you have to look where and how these data are used further in the code.

With the previous version, get-all-atts returned a list of dotted pairs (TAG . VALUE) where you accessed to TAG with car and to VALUE with cdr.

With the new version, you acces to TAG with car, to PROMPT with cadr and to VALUE with caddr.

If you do not clearly know the différences between cons, list, car, cdr, cadr, caddr, you're missing the basics to try to edit such a routine.

To learn LISP (or any programming language), you should start with simpler goals and solve them fully by yourself.

[_gile]

This is perhaps because you try to do the same thing with constant and non-constant attributes. Constant attributes do not have prompt string)

[DGRL]

Hi @_gile

Thanks for the reply
I do know the difference between cons, list, car, cdr, cadr, caddr
I already have the basis that is needed to code just not familiar with writing to excel

Already used caar car cadr caddr cadddr a lot of times so I do not need explanation on that part

Yes cons is something I overlooked and did not know that cons will only accept 2 inputs

Nevertheless the error was not caused by the cons but something else

As you can see I changed it cons into list and still the same error

If I look at the (setq att_list (get-all-atts item)) output in original code it has 2 values with a dot in between that's correct

now the modify part

The (setq att_list (get-all-atts item)) will go to  

(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes))
    (vl-catch-all-apply (function (lambda()
   (mapcar (function (lambda (x)
         (cons (vla-get-TagString x)
        (vla-get-TextString x))))
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )
 ))))))

It really does not matter what I do here but PROMPT is not accepted

I even removed the (vlax-invoke obj 'Getconstantattributes) from the code

to see if that will work but it did not

(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes))
    (vl-catch-all-apply (function (lambda()
   (mapcar (function (lambda (x)
         (list (vla-get-TagString x)(vla-get-PromptString x)
        (vla-get-TextString x))))
    (append (vlax-invoke obj 'Getattributes)
    ; (vlax-invoke obj 'Getconstantattributes)
    )
 ))))))

As you can see I commented out the 'Getconstantattributes
Then I run the code without the prompt to see if it is working and yes it is.

then I added the prompt part just to see if variable will be filled with the 3 things I ask.
Gives the same error again
I disabled the whole excel part as I do not need that here so all the errors I get is from the get-all-atts part

pls do not assume if someone can code or not just because he/she is struggling with things that are easy to do for another

[_gile · Accepted solution]

Sorry, my mistake. Attribute references do not have a PromptString property. Only the attribute definition have one, so you have to get it from the attribute definition

Try like this:

(defun get-all-atts (obj / prompts)
  (if (and obj
	   (= (vla-get-ObjectName obj) "AcDbBlockReference")
	   (eq :vlax-true (vla-get-HasAttributes obj)))
    (progn
      (vlax-for	o (vla-Item
		    (vla-get-Blocks
		      (vla-get-ActiveDocument (vlax-get-acad-object))
		    )
		    (vla-get-EffectiveName obj)
		  )
	(if (= (vla-get-ObjectName o) "AcDbAttributeDefinition")
	  (setq	prompts	(cons (cons (vla-get-TagString o) (vla-get-PromptString o))
			      prompts
			)
	  )
	)
      )
      (mapcar
	(function
	  (lambda (x)
	    (list
	      (vla-get-TagString x)
	      (cdr (assoc (vla-get-TagString x) prompts))
	      (vla-get-TextString x)
	    )
	  )
	)
	(append	(vlax-invoke obj 'Getattributes)
		(vlax-invoke obj 'Getconstantattributes)
	)
      )
    )
  )
)

Sorry if I offend you, that wasn't my intent.

Anyway, even if cons wasn't the final cause of the error it certainly raised one too. Try (cons 1 2 3)...

[DGRL]

@_gile

The last code you sent did the job.

The list is now complete and the last thing for me to do is take care of the output to excel

Really appreciate your afford helping me 🙂