DATUM AUTOMATISCH USW. (Autodesk/Lisp)

Wie wäre es mit 'ner Lisp-Funktion die Dir den String als
Attributwert auf Knopfdruck einträgt?
Nachfolgenden Code als z.B. Att.lsp im Acad Suchpfad speichern.
Folgendes Makro auf Button legen:
^c^c(if (null GET-SFELD)(load "att.lsp"))(GET-SFELD '(("ATTRIBUTNAME" . "ATTRIBUTWERT")) "BLOCKNAME");

Code:

;; Argumente:
;; Attributliste = Liste aus cons-Paaren wobei der 1. Wert den Attributnamen, der 2. Wert den Attributwert enthält
;; Beispiel: '(("ID" . "1284")("DATUM" . "12.01.04")("NAME" . "Wer bin ich?"))
;; Blockname = Name des zu modifizierenden Blocks
(defun GET-SFELD (ATTRIBUTLISTE BLOCKNAME / BOBJ)
(if (not (setq BOBJ (ssget "x"
(list (cons 0 "Insert")
(cons 2 BLOCKNAME)
(cons 410 (getvar "ctab"))
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
) ;_ end of not
(princ (strcat "\nKeine Blockeinfügung mit dem Namen >"
BLOCKNAME
"< gefunden. Funktionsende."
) ;_ end of strcat
) ;_ end of princ
(if (> (sslength BOBJ) 1)
(princ
(strcat "\nMehr als eine Blockeinfügung >"
BLOCKNAME
"< im aktuellen Bereich gefunden."
"\nKeine Änderungen vorgenommen. Funktionsende."
) ;_ end of strcat
) ;_ end of princ
(ED-ATT2 ATTRIBUTLISTE (ssname BOBJ 0))
) ;_ end of if
) ;_ end of if
(princ)
)

;; Funktion tauscht evtl. vorhandenen Attributwerte für Attributnamen aus
;; Argumente cons-Attliste z.B.: (("NR" . "10")("BAUART" . "Peitschenleuchte")) und Elementname
(defun ED-ATT2 (ATTLST ENAME / ATTOBJ ATTS MODIFIED OLD RETVAL VAL)
(setq ENAME (->VLA-OBJECT ENAME))
(if (setq VAL (ALL-BL-TXT ENAME))
(progn
(foreach NEW ATTLST
(if (setq OLD (assoc (car NEW) VAL))
(if (not (equal NEW OLD))
(setq VAL (subst NEW OLD VAL)
MODIFIED (cons NEW MODIFIED)
) ;_ end of setq
) ;_ end of if
) ;_ end of if
) ;_ end of foreach
(if MODIFIED
(progn
(setq ATTS (vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method ENAME 'GETATTRIBUTES)
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of setq
(while ATTS
(if (setq VAL (assoc (VLAX*GET-PROPERTY
(setq ATTOBJ (car ATTS))
'TAGSTRING
) ;_ end of VLAX*GET-PROPERTY
MODIFIED
) ;_ end of assoc
) ;_ end of setq
(VLAX*PUT-PROPERTY ATTOBJ 'TEXTSTRING (cdr VAL))
) ;_ end of if
(setq ATTS (cdr ATTS))
) ;_ end of while
(setq RETVAL ENAME)
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
RETVAL
) ;_ end of defun
;;; Funktion gibt vla-Objekt zurück, wenn Lisp-Objekt oder vla-Objekt
;;; übergeben worden sind. Ansonsten nil
(defun ->VLA-OBJECT (ENAME /)
(cond
((= (type ENAME) 'ENAME) (vlax-ename->vla-object ENAME))
((= (type ENAME) 'VLA-OBJECT) ENAME)
(t NIL)
) ;_ end of cond
) ;_ end of defun
;;; Funktion durchsucht den Block, der über ename übergeben wird,
;;; nach ATTRIB's und erzeugt 'ne Textliste
;;; Retval: Liste der Texte oder nil
;; Hier vl-Version
(defun ALL-BL-TXT (ENAME / EDATA RETVAL ATTS)
(setq ENAME (->VLA-OBJECT ENAME)
RETVAL '() ;_ Liste initialiseren
) ;_ end setq
(if (= (VLAX*GET-PROPERTY ENAME 'HASATTRIBUTES) :vlax-true)
(progn
(setq ATTS (vlax-safearray->list
(vlax-variant-value
(vlax-invoke-method ENAME 'GETATTRIBUTES)
) ;_ end of vlax-variant-value
) ;_ end of vlax-safearray->list
) ;_ end of setq
(while ATTS
(setq RETVAL
(cons (cons
(VLAX*GET-PROPERTY (car ATTS) 'TAGSTRING)
(VLAX*GET-PROPERTY (car ATTS) 'TEXTSTRING)
) ;_ end of cons
RETVAL
) ;_ end of cons
) ;_ end of setq
(setq ATTS (cdr ATTS))
) ;_ end of while
(setq RETVAL (reverse RETVAL))
) ;_ end progn
) ;_ end if
RETVAL
)
;;; Mapcar-Magie!
;;; Eigenschaftswerte aus Objekten lesen
;;; Beispiel:
;;; Layerfarbe des aktuellen Layers abfragen:
;;; (vlax*get-property nil '(Color ActiveLayer ActiveDocument))
;;;
;;; Abfragen, ob eine Polylinie geschlossen ist:
;;; (VLAX*GET-PROPERTY (vlax-ename->vla-object (car (entsel))) 'CLOSED)
(defun VLAX*GET-PROPERTY (OBJ PROPS /)
(if (->VLA-OBJECT OBJ) ;_ Wenn vla-Objekt draus gemacht werden kann...
(setq OBJ (->VLA-OBJECT OBJ)) ;_ mache auf jeden Fall eines draus
) ;_ end of if
(if (null OBJ)
(setq OBJ (vlax-get-acad-object))
) ;_ end of if
(if (and (listp PROPS) (cdr PROPS))
(vlax-get-property
(VLAX*GET-PROPERTY OBJ (cdr PROPS))
(car PROPS)
) ;_ end of vlax-get-property
(vlax-get-property
OBJ
(if (listp PROPS)
(car PROPS)
PROPS
) ;_ end of if
) ;_ end of vlax-get-property
) ;_ end of if
) ;_ end of defun
;;; Mapcar-Magie!
;;; Eigenschaftswerte für Objekte setzen
;;; Beispiel:
;;; Layerfarbe des aktuellen Layers auf 'Rot' setzen:
;;; (vlax*put-property nil '(Color ActiveLayer ActiveDocument) 1)
;;;
;;; Polylinie schliessen:
;;; (VLAX*PUT-PROPERTY (vlax-ename->vla-object (car (entsel))) 'CLOSED :vlax-true)
(defun VLAX*PUT-PROPERTY (OBJ PROPS VALUE /)
(if (->VLA-OBJECT OBJ) ;_ Wenn vla-Objekt draus gemacht werden kann...
(setq OBJ (->VLA-OBJECT OBJ)) ;_ mache auf jeden Fall eines draus
) ;_ end of if
(if (null OBJ)
(setq OBJ (vlax-get-acad-object))
) ;_ end of if
(if (and (listp PROPS) (cdr PROPS))
(vlax-put-property
(VLAX*GET-PROPERTY OBJ (cdr PROPS))
(car PROPS)
VALUE
) ;_ end of vlax-put-property
(vlax-put-property
OBJ
(if (listp PROPS)
(car PROPS)
PROPS
) ;_ end of if
VALUE
) ;_ end of vlax-put-property
) ;_ end of if
) ;_ end of defun
(princ)

------------------
Ciao,
Marc

[Diese Nachricht wurde von marc.scherer am 11. Mai. 2004 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP