TuttoCAD Forum

TuttoCAD Forum
[ Home | Registrati | Discussioni Attive | Discussioni Recenti | Segnalibro | Msg privati | Sondaggi Attivi | Utenti | Album Fotografico | Download | | Cerca | FAQ ]
Nome Utente:
Password:
Salva Password
Password Dimenticata?

 Tutti i Forum
 1 - TuttoCAD Software
 AutoLISP
 Update Titleblock Attributes
 Nuova Discussione  Rispondi
 Versione Stampabile Bookmark this Topic Aggiungi Segnalibro
I seguenti utenti stanno leggendo questo Forum Qui c'è:
Autore Discussione Precedente Discussione Discussione Successiva  

arri
Utente Master


Regione: Lombardia


14951 Messaggi

Inserito il - 19 maggio 2011 : 13:21:33  Mostra Profilo Invia a arri un Messaggio Privato  Rispondi Quotando
This program offers the ability to automatically update drawing titleblock attributes with values sourced from a CSV drawing register.

The program is designed to run when loaded and may be added to either the Startup Suite or ACADDOC.lsp to enable titleblocks to be automatically updated upon opening a drawing or running a script. Consequently, when a drawing is opened, a CSV Drawing Register may be selected or automatically read by the program, and titleblock attributes are updated using values corresponding to the drawing entry in the register.

The CSV Drawing Register should take the following format:
DWG [Layout] TAG1 TAG2 ... TAGN
Drawing1.dwg Layout1 Value1 Value2 ... ValueN
Drawing1.dwg Layout2 Value1 Value2 ... ValueN
Drawing2.dwg Layout1 Value1 Value2 ... ValueN
...

An example of a CSV Drawing Register demonstrating the above format is available for download from the link at the top of this page.

When the program is run: if the drawing name (with extension) appears in the first column of the CSV Drawing Register, attributes with tags corresponding to the column headings will be updated with values from the row in which the Drawing filename resides.

The 'Layout' column is optional; if present in the CSV Drawing Register, the flag at the top of the code must be set, else the 'Layout' column will be treated as another attribute tag. If the 'Layout' column is used, titleblock attributes will be updated for each layout in a row associated with the Drawing filename.

A block filter is also included in the settings at the top of the code so that the user may opt to update specific blocks within drawings. This block filter may use wildcards, i.e. "*BORDER". If nil or set to "*", all blocks with attribute tags equal to the column headings in the CSV Drawing Register will be updated with the corresponding values.

arri
Utente Master


Regione: Lombardia


14951 Messaggi

Inserito il - 21 maggio 2013 : 10:58:31  Mostra Profilo Invia a arri un Messaggio Privato  Rispondi Quotando
fonte

(defun C:demo(/ *error *acapp acsp adoc adocs attfound attitems attpairs atts attvalues blkdoc blkpath block data dir
doc elapstime endtime files found nblock newrev num1 num2 oldrev pfs ppt seldata seltype sfar
starttime tags title title_atts title_block t_atts values xlapp xlrange)
(vl-load-com)
(defun *error* (s)
;|(vl-bt)|;
(princ s))
;; Excel part follows
;; File "LDF.xls" must be open then select 926 rows in columns A-C, save file and minimize them, but do not close !
(setq xlapp (vlax-get-or-create-object "Excel.Application"))
(setq xlrange (vlax-get-property
(vlax-get-property xlapp 'selection)
'rows)
)

(setq data (vlax-safearray->list
(vlax-variant-value
(vlax-get-property xlrange 'value2)))
)

(vla-close (vlax-get-property xlapp 'activeworkbook):vlax-false)
(gc)
(vla-quit xlapp)
(vlax-release-object xlapp)
(gc)
;; parse excel data to readable list
(setq values (mapcar '(lambda(x)(mapcar' vlax-variant-value x)) data))
(setq attItems (mapcar '(lambda(x)(list (car x)(cadr x)(if (caddr x)(itoa (fix (caddr x)))"-")(itoa (fix (last x)))))(cdr values)))

;; AutoCAD parts is goes here

;; title block name
(setq title "A$C7E7E5F7C")
;; attributes to change of the title block
;;; (setq title_atts (list
;;; (cons "CONTRACTOR'S_NUMBER" "")
;;; (cons "NUMBER_VALE" "")
;;; (cons "REVISION" "")
;;; (cons "ESCALE" (strcat "1:" (itoa (fix(getvar "dimscale")))))))
;; insertion point of "c_sdk" block
(setq ppt (vlax-3d-point (list 2970.0000 0.0000 0.0000)))
;; attribute values of "c_sdk" block
(setq attvalues (list "B" "DRAWING REALESED FOR MANUFACTURING" "E" "15/11/12" "WG" "BA" "WM" "VSP"))
;; attribute tags of "c_sdk" block
(setq tags
(list "1REVISAO"
"1DESCR"
"1TE"
"1DATA"
"1DES"
"1VERIF"
"1APROV"
"1LIBER"
) ;_ end of list
)


;;selection types
(setq seltype(vlax-safearray-fill
(vlax-make-safearray vlax-vbinteger
(cons 0 1)
)
(list 0 2)
)
)
;;selection values
(setq seldata(vlax-safearray-fill
(vlax-make-safearray vlax-vbvariant
(cons 0 1)
)
(list "insert" title)
)
)


(setq acApp(vlax-get-acad-object))
(setq adoc (vla-get-activedocument acApp))
(and (setq dir "C:/Users/BATCH/");; change directory path to your search path
(setq files (vl-directory-files dir "*.dwg" 1))
)
(setq attItems (vl-remove-if-not '(lambda (x)(member (cadr x) (mapcar 'vl-filename-base files ) ))attItems))
(setq files (mapcar '(lambda (x)(strcat dir x))files))

(setq adocs (vla-get-documents acApp))
(setvar "sdi" 0)
;; change location of "c_sdk" block here:
(setq blkPath "C:/Users/ACCESS/PROCESS.dwg")
(setq startTime (getvar "cdate"))


(foreach dwgPath files
(if
;; get the data record for this document
(setq found (car (vl-remove-if-not '(lambda (x)(eq (cadr x) (vl-filename-base dwgPath))) attItems)))
(progn
(setq num1 (car found)
num2 (cadr found)
oldrev (caddr found)
newrev (last found))

;(setq acsp (vla-get-modelspace dwg))

(setq doc (vla-open adocs dwgPath :vlax-false ""))
;; change attribute list for title block here
(setq title_atts (list
(cons "CONTRACTOR'S_NUMBER" num1)
(cons "NUMBER_VALE" num2)
(cons "REVISION" newrev)
(cons "ESCALE" (strcat "1:" (itoa (fix(vlax-variant-value (vla-getvariable adoc "dimscale"))))))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) "c_sdk")))
(progn

(setq blkDoc (vla-open adocs blkPath :vlax-false))
(setq block (vl-catch-all-apply 'vla-item (list (vla-get-blocks blkDoc) "c_sdk")))
(setq sfar
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject
(cons 0 0)
)
(list block)
)
)
)
(not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vla-copyobjects
blkDoc ;;source drawing that is contains the block definition
sfar
(vla-get-blocks doc)
)
)
))
)

(vla-close blkDoc)(vlax-release-object blkDoc)))
(if (not(vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) "c_sdk"))))
(progn
(vla-setvariable doc "ctab" "Model")
(setq acsp (vla-get-modelspace doc))
(setq pfs (vla-get-pickfirstselectionset doc))(vl-catch-all-apply 'vla-clear (list pfs))
(vla-zoomextents (vla-get-application doc))
(vla-select pfs acselectionsetall nil nil seltype seldata)
(setq title_block (vl-catch-all-apply 'vla-item (list pfs 0)))
;; change title block attributes
(setq t_atts (vlax-invoke title_block 'getattributes))

(foreach att t_atts
(if (setq attfound (assoc (vla-get-tagstring att )title_atts))
(vla-put-textstring att (cdr attfound))))

(setq nblock(vl-catch-all-apply 'vla-insertblock (list acsp ppt "c_sdk" 5 5 5 0)))
(vl-catch-all-apply 'vla-put-xeffectivescalefactor (list nblock 5))
(vl-catch-all-apply 'vla-put-Yeffectivescalefactor (list nblock 5))
(vl-catch-all-apply 'vla-put-zeffectivescalefactor (list nblock 5))
;; change "c_sdk" block attributes
(setq atts (vlax-invoke nblock 'getattributes))
(setq attpairs (mapcar 'cons tags attvalues))
(foreach att atts
(if (setq attfound (assoc (vla-get-tagstring att)attpairs))
(vla-put-textstring att (cdr attfound))))
(vla-save doc)(vla-close doc)))))

)
(setq endTime (getvar "cdate"))

(setq elapsTime (rtos (- endTime startTime)2 6))
(alert (strcat"Time elapsed:\t" elapsTime))
(princ)
)
Torna all'inizio della Pagina
  Discussione Precedente Discussione Discussione Successiva  
 Nuova Discussione  Rispondi
 Versione Stampabile Bookmark this Topic Aggiungi Segnalibro
Vai a:
TuttoCAD Forum © 2001-2010 CADLandia Torna all'inizio della Pagina
Pagina generata in 0,47 secondi.