Vytisknout stránku | Zavřít okno

Automatické prohození hodnot atributů v blocích

Vytištěno z: CAD Fórum
Kategorie: Autodesk - stavebnictví, strojírenství, CAD/GIS
Název fóra: AutoCAD
Popis fóra: Otázky kolem aplikací AutoCAD a AutoCAD LT, AutoCAD 360, prohlížečů, DWG a DWF, Design Review, Navisworks, nadstavby, 123D, A360 a cloud Autodesk 360
URL: https://www.cadforum.cz/forum/forum_posts.asp?TID=30152
Datum vytištění: 29.dub.2026 v 18:36


Téma: Automatické prohození hodnot atributů v blocích
Odeslal: sumi
Předmět: Automatické prohození hodnot atributů v blocích
Datum odeslání: 09.bře.2020 v 12:16
Poprosím Vás o radu viz. níže.
Potřeboval bych automaticky prohodit vyplněné hodnoty atributů v blocích.
Bloky mají své atributy např. název "A" a "B", potřebuji vyplněné hodnoty "A"=1 "B"=2 prohodit tzn. po vykonání "funkce" bude mít v bloku atribut "A" hodnotu 2 a "B" hodnotu 1.
Bloky mají různé názvy, tzn.: funkce by neměla brát v potaz název bloku ale najít atribut "A" a atribut "B" v libovolných názvech bloků a hodnoty prohodit (bez ohledu na název bloku).


Něco v tomto smyslu:  http://www.lee-mac.com/attributecolour.html" rel="nofollow - http://www.lee-mac.com/attributecolour.html
Jen to nebude označovat barevně, ale prohodí atribut A s atributem B.




Odpovědi:
Odeslal: johny
Datum odeslání: 09.bře.2020 v 13:18
(defun c:AttSwap ( / ss t1 t2 i en v1 v2)

  (if (and (setq ss (ssget ":L" '((0 . "INSERT") (66 . 1))))
   (setq t1 (getstring "\nTag 1: "))
   (setq t2 (getstring "\nTag 2: "))
   )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i))))
      (and (setq v1 (getpropertyvalue en t1))
   (setq v2 (getpropertyvalue en t2))
   (not (setpropertyvalue en t1 v2))
   (not (setpropertyvalue en t2 v1)))))
  (princ)
  )


Odeslal: sumi
Datum odeslání: 09.bře.2020 v 13:32
Vrací chybu žádná definice funkce GETPROPERTYVALUE


Odeslal: johny
Datum odeslání: 09.bře.2020 v 14:53
Hmm, máte docela starý autocad.
Pak použijte místo get/setpropertyvalue tyto:

http://www.lee-mac.com/attributefunctions.html" rel="nofollow - http://www.lee-mac.com/attributefunctions.html

Aspon se něco naučíte.


Odeslal: sumi
Datum odeslání: 09.bře.2020 v 15:55
Zkuste mě prosím trochu více popostrčit. Jsem úplný začátečník a je to pro začátek velké sousto.


Odeslal: johny
Datum odeslání: 09.bře.2020 v 17:19
(defun c:AttSwap ( / ss t1 t2 i en v1 v2)

  (if (and (setq ss (ssget ":L" '((0 . "INSERT") (66 . 1))))
   (setq t1 (getstring "\nTag 1: "))
   (setq t2 (getstring "\nTag 2: "))
   )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i))))
      (and (setq v1 (LM:getattributevalue  en t1))
   (setq v2 (LM:getattributevalue  en t2))
   (LM:setattributevalue  en t1 v2)
   (LM:setattributevalue  en t2 v1))))
  (princ)
  )



;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:getattributevalue ( blk tag / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (cdr (assoc 1 (reverse enx)))
            (LM:getattributevalue blk tag))))

;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:setattributevalue ( blk tag val / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
            (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                (progn
                    (entupd blk)
                    val))
            (LM:setattributevalue blk tag val))))


Odeslal: sumi
Datum odeslání: 10.bře.2020 v 18:59
Skvělé Big smile
Funguje jak má, děkuji.



Vytisknout stránku | Zavřít okno