Export Specific attribute named block X, Y coordinates to Excel
@Yamishon_Noah wrote:
Hi experts,
So, I want to extract only these block attributed Tag "TYPE" X & Y coordinates to Excel.
Appreciate your helps
With Data Extraction you can this result...
It is not the attribute definitions coordinates but the blocks' insertion point
Is that what you're after? or something else?
(defun c:demo ( / LM:open ss i vl_e ins_point valid_tag All_data filetowrite)
;; pBe May 2018
;; Open - Lee Mac
;; A wrapper for the 'Open' method of the Shell Object
;; target - [int/str] File, folder or ShellSpecialFolderConstants enum
(defun LM:open ( target / rtn shl )
(if (and (or (= 'int (type target)) (setq target (findfile target)))
(setq shl (vla-getinterfaceobject (vlax-get-acad-object) "shell.application"))
)
(progn
(setq rtn (vl-catch-all-apply 'vlax-invoke (list shl 'open target)))
(vlax-release-object shl)
(if (vl-catch-all-error-p rtn)
(prompt (vl-catch-all-error-message rtn))
t
)
)
)
)
(and
(setq ss (ssget "_X" '((0 . "INSERT")(66 . 1)(410 . "Model"))))
(setq csvfile (getfiled "Enter CSV file name" (getvar 'dwgprefix) "csv" 1))
(repeat (setq i (sslength ss))
(setq vl_e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(setq ins_point (vlax-get vl_e 'Insertionpoint))
(if (setq valid_tag
(Cdr (assoc "TYPE"
(mapcar '(lambda (at)
(list (vla-get-tagstring at) (vla-get-textstring at))
)
(vlax-invoke vl_e 'GetAttributes)
)
)
)
)
(setq All_data (cons (list (vla-get-EffectiveName vl_e)
(strcat (Car valid_tag) ","
(rtos (car ins_point) 2) ","
(rtos (cadr ins_point) 2)
)
) All_data))
)
All_data
)
(setq filetowrite (open csvfile "w"))
(foreach itm (vl-sort All_data '(lambda (a b)(< (Car a)(car b))))
(write-line (strcat (Car itm) "," (Cadr itm)) filetowrite))
(not (close filetowrite))
(LM:OPEN csvfile)
)
(princ)
)
well...
(defun c:demo ( / ss i vl_e ins_point valid_tag All_data filetowrite xlCells Excel_exist col row)
;; pBe May 2018
(if
(and
(setq All_data nil
ss (ssget "_X" '((0 . "INSERT")(66 . 1)(410 . "Model"))))
(repeat (setq i (sslength ss))
(setq vl_e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
(setq ins_point (vlax-get vl_e 'Insertionpoint))
(if (setq valid_tag
(Cdr (assoc "TYPE"
(mapcar '(lambda (at)
(list (vla-get-tagstring at) (vla-get-textstring at))
)
(vlax-invoke vl_e 'GetAttributes)
)
)
)
)
(setq All_data (cons (list (vla-get-EffectiveName vl_e)
(Car valid_tag) (rtos (car ins_point) 2) (rtos (cadr ins_point) 2)
)
All_data))
)
All_data
)
)
(cond
( (null All_data) )
( (setq Excel_exist (vlax-get-or-create-object "Excel.Application"))
(setq col 1 row 1)
(setq xlCells (vlax-get-property
(vlax-get-property
(vlax-get-property
(vlax-invoke-method
(vlax-get-property Excel_exist "Workbooks")
"Add"
)
"Sheets"
)
"Item" 1
)
"Cells"
)
)
((lambda (n)
(foreach val '("Block Name" "Value" "X" "Y" )
(vlax-put-property xlCells 'Item row (setq n (1+ n)) val)
)
)
0
)
(vlax-put-property xlCells 'ColumnWidth 15.00)
(foreach itm (vl-sort All_data '(lambda (a b)(< (Car a)(car b))))
(setq row (1+ row))
((lambda (n)
(foreach val itm
(vlax-put-property xlCells 'Item row (setq n (1+ n)) val)
)
)
0
)
)
(vla-put-visible Excel_exist :vlax-true)
(mapcar (function (lambda (obj)
(and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-release-object) (list obj)
)
)
)
)
)
)
(list Excel_exist xlCells))
(setq Excel_exist nil
xlCells nil)
)
( (setq csvfile (getfiled "Enter CSV file name"
(strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) "CSV" 1))
(setq filetowrite (open csvfile "w"))
(foreach itm (vl-sort All_data '(lambda (a b)(< (Car a)(car b))))
(write-line (strcat (Car itm) "," (Cadr itm)) filetowrite))
(close filetowrite)
(startapp "notepad")
)
)
)
(princ)
)
You'll be able to save the excel file to whatever name and location after the program ends.
HTH
@Anonymous wrote:
I added one more tag in the attribute block.
plz modify the codes once more. Thank you very much.
Are you Yamishon_Noah? The way you ask for modification is as if you are the original poster.