I'm looking for a Lisp to create excel drawing list from drawing attributes

I'm looking for a Lisp to create excel drawing list from drawing attributes

David125
Collaborator Collaborator
536 Views
2 Replies
Message 1 of 3

I'm looking for a Lisp to create excel drawing list from drawing attributes

David125
Collaborator
Collaborator

I'm looking for a routine that will export data from specific attributes to create a list on a single excel sheet. As an example I've attached a sample cad file and what I'm trying to get on an excel file. 

It's been many moons since I wrote any code, i have an old rotine I wrote years ago but I keep getting an error message.-   ; error: no function definition: DXF

 

My old routine,

(defun c:ext ()
  (setq file (open "c:\\attrib.CSV" "a")
i    -1
  )
 
 ; (setq file (open "c:\\attrib.CSV" "a")i    -1)
 
  (setq OTB (ssget "x" '((2 . "30x42"))))
 
  (if (/= OTB nil)
    (setq EN (entget (ssname OTB 0)))
    (alert "30x42 not found")
  )
 
  (setq EN (entget (ssname OTB 0)))
 
 
  (repeat 50
    (setq en (entget (entnext (dxf -1 en))))
    (setq at1 (cdr (assoc 1 en)))
    (setq at2 (cdr (assoc 2 en)))
 
    (if (= at2 "BLDGN")
      (setq BLDGN at1)
    );---
    (if (= at2 "DWGTITLE")
      (setq DWGTITLE at1)
    );---
    (if (= at2 "ERNUM")
      (setq ERNUM at1)
    );---
    (if (= at2 "CNTL")
      (setq CNTL at1)
    );---
    (if (= at2 "TEMPID")
      (setq TEMPID at1)
    );---
 
  )
 
(setq SPACE " ")
 
(setq strin
 
       (strcat SPACE "," BLDGN " , " ERNUM " , " TEMPID " , " DWGTITLE " , " SPACE "," SPACE "," SPACE " , " (getvar "dwgname") "," CNTL))
 
  (WRITE-LINE strin file)
 
 
 
  (close file)
  (princ)
)
 
 
 
;|«Visual LISP© Format Options»
;(130 2 40 2 nil "end of " 90 9 0 0 1 T T nil T)
;*** DO NOT add text below the comment! ***|;

 

0 Likes
537 Views
2 Replies
Replies (2)
Message 2 of 3

Sea-Haven
Mentor
Mentor

Try this, note the block does not have the tag names you mentioned but others can be added.

 

; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/i-m-looking-for-a-lisp-to-create-excel-drawing-list-from-drawing/td-p/11983669
; d1 dwg
; By AlanH May 2023

(defun c:atts2excel ( / myxl lays laynum atts attnames numatts ss obj y x lst val cell)

; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
(defun Number2Alpha (Num# / Val#)
  (if (< Num# 27)
    (chr (+ 64 Num#))
    (if (= 0 (setq Val# (rem Num# 26)))
      (strcat (Number2Alpha (1- (/ Num# 26))) "Z")
      (strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
    )
  )
)

; put cell by alanh

(defun putcell (cellname val1 / myrange)
  (setq myRange (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" cellname))
  (vlax-put-property myRange 'Value2 val1)
)

(setq myxl (vlax-get-object "Excel.Application"))
(if (= myxl nil)
(progn
  (setq myxl (vlax-get-or-create-object "excel.Application"))
  (vlax-invoke-method (vlax-get-property myxl 'WorkBooks) 'Add)
  (vla-put-visible myXL :vlax-true)
  (vlax-put-property myxl 'ScreenUpdating :vlax-true)
  (vlax-put-property myXL 'DisplayAlerts :vlax-true)
)
)

(setq lays (layoutlist))
(setq laynum (length lays))
(setq attnames (list "BLDGN" "DWGTITLE" "TEMPID"))
(setq numatts (length attnames))

(putcell "A1" (getvar 'dwgname))
(setq row 2 col 1)

(foreach lay lays
  (setvar 'ctab lay)
  (setq ss (ssget "x"  (list (cons 0 "INSERT") (cons 2 "30x42")(cons 410 lay))))
  (setq obj (vlax-ename->vla-object (ssname ss 0)))
  (setq atts (vlax-invoke obj 'Getattributes))
  (setq y 0 lst '())
  (repeat numatts
    (setq attname (nth Y attnames))
    (setq x 0)
    (repeat (length atts)
    (if (= attname (vla-get-tagstring (nth x atts)))
      (setq lst (cons (vla-get-textstring (nth x atts)) lst))
    )
    (setq x (1+ x))
    )
    (setq y (1+ y))
  )
; export to excel here
  (foreach val lst
    (setq cell (strcat (Number2Alpha col) (rtos row 2 0)))
    (putcell cell val)
    (setq col (1+ col))
  )
  (setq row (1+ row) col 1)
)

(vlax-release-object myxl)
(setq myxl nil)

(princ)
)

(c:atts2excel)

 Best to not have Excel open as will overwrite an existing excel file. 

0 Likes
Message 3 of 3

komondormrex
Mentor
Mentor

you may have found it

 

(defun c:ext (/ attributes_list csv_full_name csv_file_id block_sset attributes_assoc_list csv_attribute_line)
	(setq attributes_list '(tempid bldgn dwgtitle cadfilenum))
	(if (findfile (setq csv_full_name "c:\\Attrib.csv"))
		(progn
			(write-line (strcat "File \"" csv_full_name "\" has been opened for appending."))
			(setq csv_file_id (open csv_full_name "a"))
		)
		(progn
			(setq csv_file_id (open csv_full_name "a"))
			(write-line (strcat "File \"" csv_full_name "\" has been created for writing."))
			(write-line (substr (apply 'strcat (mapcar 'strcat (mapcar '(lambda (attribute) (strcat ";" attribute)) (mapcar 'vl-princ-to-string attributes_list)))) 2) csv_file_id) 
		)
	)
	(while (if (setq block_sset (vl-catch-all-apply 'ssget (list "_x" '((0 . "insert") (2 . "30x42")))))
					(progn
			   			(setq block_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex block_sset)))))
						(foreach block block_list 
			   				(if (minusp (vlax-get block 'hasattributes))
									(progn
										(setq attributes_assoc_list (mapcar '(lambda (attribute) (cons attribute "")) attributes_list))
										(foreach attribute (vlax-invoke block 'getattributes)
											(if	(member (read (vla-get-tagstring attribute)) attributes_list)
												(progn
													(setq attributes_assoc_list (subst (cons (read (vla-get-tagstring attribute)) (vla-get-textstring attribute))
																					  (assoc (read (vla-get-tagstring attribute)) attributes_assoc_list)
																					  attributes_assoc_list
																			   )
													)
												)
											)
										)
										(if (/= ";;;" (setq csv_attribute_line (substr (apply 'strcat (mapcar '(lambda (attribute) (strcat ";" (cdr attribute)))
																													attributes_assoc_list
																	  									)
													   								   )
													   								   2
											   								  )
													 )
											)
												(progn
													(write-line (strcat "\nLine \"" csv_attribute_line "\" has been added to CSV file"))
													(write-line csv_attribute_line csv_file_id)
												)
												(princ "None attributes found to be appended to CSV file")
										)
									)
			   				)
						)
						(write-line (strcat "File \"" csv_full_name "\" has been closed."))
						(close csv_file_id)
					)
					(progn
						(write-line (strcat "File \"" csv_full_name "\" has been closed."))
						(close csv_file_id) 
					)
			)
	)
	(princ)
)
0 Likes