---

Hallo @All!

Ich such nach einem Lisp Tool, dass meine Blocknamen konvertiert.
Z.B. Alter Blockname "01" Neuer Name "Lampe"
Hat jemand schon mal sowas geschrieben??? Wer kann mir da helfen, denn ich habe von AutoLisp no Peilung....

mfg Flo

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

---

Erstens ... wenn du die Namen kennst .. gibt es in ACAD den Befehl umbenenn  und wenn nicht ...
Hatte da mal was geschrieben :
Guckst du Hier .
Funzt ganz gut bei benannten Blöcken. Für anonyme ist ein anderer Ansatz erforderlich.

Soviel zur direkten Hilfe... Zwecks Selbsthilfe und no Peilung gucke mal : www.defun.de  bzw. http://www.autolisp-tutorial.mapcar.net
------------------
    - Thomas -

[Diese Nachricht wurde von CADmium am 06. Mai. 2004 editiert.]

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

---

Danke für die Hilfe... aber diese Lisp ist ja genauso wie der befehl _rename. Ich suche was automatisiertes. Am besten mit einer externen Datei, wo man den alten und den neuen Namen definieren kann.
Wäre klasse, wenn es so eine Lisp schon geben würde...
Das Forum ist ja echt klasse.... gibt immer sofort Lösungsvorschläge.... klasse...

mfg Flo

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

---

Hi fbeckersm,
na denn will ich mal.
Hab 'mal was für Dich zusammengestellt:
(den Vorgabe-Dateinamen für die Parameterdatei
kannst Du ja selbst im Pgm ändern.)

Vielen Dank an Axel "mapcar" Strubbe-Zettler für die ganze
mapcar-Magie (vlax*... und laden von Parameter-Files mittels load)

Format der Übersetzungsdatei:
(erster Eintrag ist der alte Name, zweiter der neue Name)

Code:

---

(list
  '("1" "Eins")
  '("2" "Zwei")
  '("3" "Drei")
  '("4" "Vier")
)

---

Programmcode:

Code:

---

;;; ActiveX Extension laden...
(vl-load-com)

(setq default-file "c:\\temp\\test.txt")

(defun C:BLRENAME (/ VAL)
  (if (setq
        val (getfiled "Parameter-Datei für Block-Umbenennung wählen"
                      DEFAULT-FILE
                      ""
                      8
            ) ;_ end of getfiled
      ) ;_ end of setq
    (progn
      (setq val (vl-catch-all-apply 'load (list val)))
      (if (vl-catch-all-error-p val)
        (alert
          "Fehler beim Lesen der Parameter-Datei!\n\nFunktionsende."
        ) ;_ end of alert
        (if (setq val (BLRENAME-FROM-LIST val))
          (princ
            (strcat
              "\nListe der neuen Blocknamen:"
              (apply
                'strcat
                (mapcar
                  (function (lambda (X)
                              (strcat "\n" (VLAX*GET-PROPERTY X 'NAME))
                            ) ;_ end of LAMBDA
                  ) ;_ end of FUNCTION
                  val
                ) ;_ end of mapcar
              ) ;_ end of apply
            ) ;_ end of strcat
          ) ;_ end of princ
          (princ "\nKeine Blöcke umbenannt.")
          )
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
)

(defun BLRENAME-FROM-LIST (LST / BLOBJ OLD RETVAL)
  (if LST
    (foreach ELEM LST
      (if (setq OLD (BLOCKNAME-REAL-CASE (car ELEM)))
        (progn
          (setq
            BLOBJ (vlax-invoke-method
                    (VLAX*GET-PROPERTY NIL '(BLOCKS ACTIVEDOCUMENT))
                    'ITEM
                    OLD
                  ) ;_ end of vlax-invoke-method
          ) ;_ end of setq
          (VLAX*PUT-PROPERTY BLOBJ 'NAME (cadr ELEM))
          (setq RETVAL (cons BLOBJ RETVAL))
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of if
  RETVAL
) ;_ end of defun

(defun BLOCKNAME-REAL-CASE (BNAME / RETVAL)
  (if (not (setq RETVAL (tblsearch "block" BNAME)))
    (princ
      (strcat "\nKein Block >"
              BNAME
              "< in aktueller Zeichnung definiert!"
      ) ;_ end of strcat
    ) ;_ end of princ
    (setq RETVAL (cdr (assoc 2 RETVAL)))
  ) ;_ end of if
  retval
) ;_ end of defun

;;; 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

---

..

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

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

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

---

Automatisches Rename ... kein Probl. oder ?

Als verfechter der einfachen Mitteln ( LT-User-freundlich  ) ) würde ein Script ausreichen,
einfach mal als Zusatzantwort:

Script als *.scr speichern und in ACAD mit SCRIPT aufrufen..

;############ Script zum umbenennen von: BLOCK ###########
_-rename _block
alterName
neuerName
_-rename _block
alterName
neuerName
_-rename _block
alterName
neuerName
usw...
usw
;######################## Script Ende #####################

------------------
- Sebastian -

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

---

@cadffm:
..

@ Alle anderen:
Habe das Ding nochmal etwas allgemeingültiger gemacht,
'n paar Beispiel-Defuns für verschiedene Tables sind dabei 's gibt aber noch mehr.
Wer findet die restlichen? :-)

Code:

---

;;; ActiveX Extension laden...
(vl-load-com)

(setq default-file "c:\\temp\\test.txt")

(defun C:RENAME-BLOCKS ()
  (RENAME-TABLE 'BLOCKS)
  (princ)
) ;_ end of defun

(defun C:RENAME-LAYERS ()
  (RENAME-TABLE 'LAYERS)
  (princ)
)

(defun C:RENAME-DIMSTYLES ()
  (RENAME-TABLE 'DIMSTYLES)
  (princ)
)

(defun C:RENAME-LAYOUTS ()
  (RENAME-TABLE 'LAYOUTS)
  (princ)
)

(defun RENAME-TABLE (COLLECTIONNAME / VAL)
  (if (setq
        VAL (getfiled "Parameter-Datei für Umbenennung wählen"
                      DEFAULT-FILE
                      ""
                      8
            ) ;_ end of getfiled
      ) ;_ end of setq
    (progn
      (setq VAL (vl-catch-all-apply 'load (list VAL)))
      (if (vl-catch-all-error-p VAL)
        (alert
          "Fehler beim Lesen der Parameter-Datei!\n\nFunktionsende."
        ) ;_ end of alert
        (if (setq VAL (RENAME-FROM-LIST COLLECTIONNAME VAL))
          (princ
            (strcat
              "\nListe der neuen Namen:"
              (apply
                'strcat
                (mapcar
                  (function (lambda (X)
                              (strcat "\n" (VLAX*GET-PROPERTY X 'NAME))
                            ) ;_ end of LAMBDA
                  ) ;_ end of FUNCTION
                  VAL
                ) ;_ end of mapcar
              ) ;_ end of apply
            ) ;_ end of strcat
          ) ;_ end of princ
          (princ "\nNichts umbenannt.")
        ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

(defun RENAME-FROM-LIST (COLLECTIONNAME LST / BLOBJ OLD RETVAL)
  (if LST
    (foreach ELEM LST
      (if (setq OLD (COLLECTIONNAME-REAL-CASE COLLECTIONNAME (car ELEM)))
        (progn
          (setq
            BLOBJ (vlax-invoke-method
                    (VLAX*GET-PROPERTY
                      NIL
                      (list COLLECTIONNAME 'ACTIVEDOCUMENT)
                    ) ;_ end of VLAX*GET-PROPERTY
                    'ITEM
                    OLD
                  ) ;_ end of vlax-invoke-method
          ) ;_ end of setq
          (VLAX*PUT-PROPERTY BLOBJ 'NAME (cadr ELEM))
          (setq RETVAL (cons BLOBJ RETVAL))
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of if
  RETVAL
) ;_ end of defun

(defun COLLECTIONNAME-REAL-CASE (COLLECTIONNAME NAME / val)
  (if (not
        (vl-catch-all-error-p
          (setq VAL (vl-catch-all-apply
                      'VLAX*GET-PROPERTY
                      (list NIL (list COLLECTIONNAME 'ACTIVEDOCUMENT))
                    ) ;_ end of vl-catch-all-apply
          ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    (if (not (vl-catch-all-error-p
               (setq VAL (vl-catch-all-apply
                           'vlax-invoke-method
                           (list VAL 'ITEM NAME)
                         ) ;_ end of vl-catch-all-apply
               ) ;_ end of setq
             ) ;_ end of vl-catch-all-error-p
        ) ;_ end of not
      (if (not (vl-catch-all-error-p
                 (setq VAL (vl-catch-all-apply
                             'VLAX*GET-PROPERTY
                             (list VAL 'NAME)
                           ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
        VAL
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of if
) ;_ end of defun

;;; 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

---

..

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

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

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

---

Danke @marc.scherer für deine Hilfe, aber wenn ich dein zweites Prog nehme, dann sagt er immer "Nichts geändert" !? Beim ersten Prog kommt eine Fehlermeldung.... HILFE...

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

---

Hi fbeckersm,
wie sieht denn Deine Parameterdatei zum umbenennen aus?
Kopier mal hier rein, oder hänge die als Datei an.
Wie lautet die Fehlermeldung?

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

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

---

NeufassungvonTextdatei.txt

Fehlermeldung bei 2 Pro:
Befehl: blrename
; Fehler: no function definition: ->VLA-OBJECT

Befehl:

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

---

Hi f.,
Sorry, habe vergessen folgende Funktion mitzuliefern...
Bitte kopiere die noch dazu.
Dann sollte es gehen... :-(

Code:

---

;;; Funktion gibt Ename zurück, wenn Lisp-Objekt oder vla-Objekt
;;; übergeben worden sind. Ansonsten nil
(defun ->ENAME (ENAME /)
  (cond
    ((= (type ENAME) 'VLA-OBJECT) (vlax-vla-object->ename ENAME))
    ((= (type ENAME) 'ENAME) ENAME)
    (t NIL)
  ) ;_ end of cond
) ;_ 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

---

..

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

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

---

Ah,
Textdatei ist in Ordnung...

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

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