Program do podmiany wartości atrybutów w tym w liście bloków

[Robert11]

Cześć mam prośbę pomoże mi ktoś przerobić ten program podmiany wartości atrybutów dla listy bloków lub kilku bloków zawartych w lispie albo zaczytywanych z Excela chociaż wolałbym nazwy bloków zadeklarować w lispie miał bym ich z 30 można przyjąć ze bloki nazywaj ą się "NAME1" , "NAME2" i tak dalej....... az do 30 nazwy atrybutów są te same i nie chce ich podawać tylko żeby lisp z automatu podmieniał konkretne dwa atrybuty miedzy sobą, pierwszy to SYMBOL a drugi to LPS miedzy tymi atrybutami chciałbym podmieniać wartości ich.

COPYCAT2.lsp

[RobS]

Hej,
Czyli LISP ma automatycznie przejść po blokach NAME1 do NAME30 i zmienić wartość atrybutu SYMBOL na wartość atrybutu LPS, i vice versa?

Czy możesz podesłać jakiś przykładowy rysunek z takimi blokami?

[Robert11]

Miał bym prośbę odnośnie napisania tego pliku mianowicie chciałbym  żeby nazwy nie były zapętlane ponieważ będę do celowo używał różnych nazw które później bym sobie podstawił pod NEMY......... , mam nadzieje że to nie będzie trudne dla mnie rozszyfrowanie tego pliku w razie potrzeby skrócenia go o kilka bloków lub wydłużenia. 

dziękuje za zainteresowanie i chęć pomocy.

PRZYKŁADOWY PLIK - Standard.zip PRZYKŁADOWY PLIK.dwg

[Robert11]

I zapomniałem wspomnieć że nie wszystkie nazwy będą używane w dwg więc błąd z powodu braku jakiegoś bloku jest bez sensu 

[kojacek]

Potrzebujesz wykonać następujące czynności:
1) załadować CADPL-Pack'a. Znajdziesz go tutaj: https://kojacek.wordpress.com/2015/11/04/cadpl-pack/
2) oraz poniższy kod definiujący polecenie ATR-ZMIANA:

; --------------------------------------------------------------------------  ;
; C:ATR-ZMIANA by kojacek 2024 (http://kojacek.wordpress.com)                 ;
; --------------------------------------------------------------------------  ;
(defun C:ATR-ZMIANA ()(jk:140824_GetBklMask)(princ))
; --------------------------------------------------------------------------  ;
(defun jk:140824_GetBklMask ( / %m %s %l %a %b %r %e %i %o :t)
  (defun :t (i)
    (getstring
      (strcat
        "\nPodaj "
        (nth i (list "pierwszy" "drugi"))
        " tag atrybutu do zamiany: "
      )
    )
  )
  (if
    (setq %m
      (getstring "\nPodaj początkowy fragment nazwy bloku: ")
    )
    (if
      (member %m (list "" " "))
      (princ "\nBłąd - zła nazwa.")
      (if
        (setq %s
          (ssget "_x"
            (list
              (cons 0 "INSERT")
              (cons 410 (getvar "CTAB"))
              (cons 2 (strcase (strcat %m "*")))
            )
          )
        )
        (progn
          (setq %l (cd:SSX_Convert %s 0))
          (if
            (and
              (setq %a (strcase (:t 0)))
              (setq %b (strcase (:t 1)))
            )
            (progn
              (setq %r
                (mapcar
                 '(lambda (% / %1 %2 %3)
                    (if
                      (setq %1 (cd:BLK_GetAtts %))
                      (if
                        (and
                          (setq %2 (cdr (assoc %a %1)))
                          (setq %3 (cdr (assoc %b %1)))
                        )
                        (list % %2 %3) 1
                      ) 1
                    )
                  ) %l
                )
                    %e (vl-remove-if-not 'numberp %r)
                    %r (mapcar 'car (vl-remove-if 'numberp %r))
              )
              (if %r
                (progn
                  (cd:SYS_UndoBegin)
                  (foreach % %r
                    (setq %i (cd:BLK_GetAtts %)
                          %o (vlax-ename->vla-object %)
                    )
                    (cd:BLK_SetAttValueVLA
                      %o %a (cdr (assoc %b %i))
                    )
                    (cd:BLK_SetAttValueVLA
                      %o %b (cdr (assoc %a %i))
                    )
                  )
                  (princ
                    (strcat
                      "\nZmieniono atrybuty w "
                      (itoa (length %r)) " blokach."
                      (if %e
                        (strcat
                          " Odrzucono " (itoa (length %e))
                          " bloków."
                        ) ""
                      )
                    )
                  )
                  (cd:SYS_UndoEnd)
                )
                (princ
                  (strcat "\n"
                    (itoa (length %l))
                    " bloków nie spełnia wymagań do zmiany atrybutów."
                  )
                )
              )
            )
            (princ "\nBłąd. Wymagane nazwy atrybutów.")
          )      
        )
        (princ "\nNie znaleziono odpowienich bloków.")
      )
    )
    (princ "\nBłąd. Brak nazwy")
  )
)
; --------------------------------------------------------------------------  ;
(princ)

3) wywołujesz polecenie ATR-ZMIANA, jak na poniższym ruchomym obrazie:
 

[Robert11]

Nie o to mi chodziło 

[kojacek]

Można się pokusić o (w istocie drobną) przeróbkę tego kodu, aby pracował w trybie "wsadowym". Kod wygląda teraz tak:

; --------------------------------------------------------------------------  ;
; C:ATR-ZMIANA by kojacek 2024 (http://kojacek.wordpress.com)                 ;
; --------------------------------------------------------------------------  ;
(defun C:ATR-ZMIANA ()(jk:140824_GetBklMask)(princ))
; --------------------------------------------------------------------------  ;
(defun jk:140824_GetBklMask ( / %m %s %l %a %b %r %e %i %o :t)
  (defun :t (i)
    (getstring
      (strcat
        "\nPodaj "
        (nth i (list "pierwszy" "drugi"))
        " tag atrybutu do zamiany: "
      )
    )
  )
  (if
    (setq %m
      (if
        (not *ATT-LIST*)
        (getstring "\nPodaj początkowy fragment nazwy bloku: ")
        (car *ATT-LIST*)
      )
    )
    (if
      (member %m (list "" " "))
      (princ "\nBłąd - zła nazwa.")
      (if
        (setq %s
          (ssget "_x"
            (list
              (cons 0 "INSERT")
              (cons 410 (getvar "CTAB"))
              (cons 2 (strcase (strcat %m "*")))
            )
          )
        )
        (progn
          (setq %l (cd:SSX_Convert %s 0))
          (if
            (and
              (setq %a (if
                         (not *ATT-LIST*)
                         (strcase (:t 0))
                         (cadr *ATT-LIST*)
                       )
              )
              (setq %b (if
                         (not *ATT-LIST*)
                         (strcase (:t 1))
                         (caddr *ATT-LIST*)
                       )
              )
            )
            (progn
              (setq %r
                (mapcar
                 '(lambda (% / %1 %2 %3)
                    (if
                      (setq %1 (cd:BLK_GetAtts %))
                      (if
                        (and
                          (setq %2 (cdr (assoc %a %1)))
                          (setq %3 (cdr (assoc %b %1)))
                        )
                        (list % %2 %3) 1
                      ) 1
                    )
                  ) %l
                )
                    %e (vl-remove-if-not 'numberp %r)
                    %r (mapcar 'car (vl-remove-if 'numberp %r))
              )
              (if %r
                (progn
                  (cd:SYS_UndoBegin)
                  (foreach % %r
                    (setq %i (cd:BLK_GetAtts %)
                          %o (vlax-ename->vla-object %)
                    )
                    (cd:BLK_SetAttValueVLA
                      %o %a (cdr (assoc %b %i))
                    )
                    (cd:BLK_SetAttValueVLA
                      %o %b (cdr (assoc %a %i))
                    )
                  )
                  (princ
                    (strcat
                      "\nZmieniono atrybuty w "
                      (itoa (length %r)) " blokach."
                      (if %e
                        (strcat
                          " Odrzucono " (itoa (length %e))
                          " bloków."
                        ) ""
                      )
                    )
                  )
                  (cd:SYS_UndoEnd)
                )
                (princ
                  (strcat "\n"
                    (itoa (length %l))
                    " bloków nie spełnia wymagań do zmiany atrybutów."
                  )
                )
              )
            )
            (princ "\nBłąd. Wymagane nazwy atrybutów.")
          )      
        )
        (princ "\nNie znaleziono odpowienich bloków.")
      )
    )
    (princ "\nBłąd. Brak nazwy")
  )
)
; --------------------------------------------------------------------------  ;
(princ)

Przed wywołaniem polecenia wystarczy teraz zadeklarować zmienną globalną o nazwie *ATT-LIST*. Jest to trzyelementowa lista gdzie pierwszy element to maska (początkowy fragment) nazwy bloku, a dwa kolejne to tagi atrybutów do zamiany. Deklaracja zmiennej:

(setq *ATT-LIST* (list "NAME" "SYMBOL" "LPS"))

Następnie wywołania polecenia ATR-ZMIANA skutkują jak na animacji poniżej.
Gdy zmienna nie jest zadeklarowana polecenie działa jak w poprzednim poście. Nie trzeba tłumaczyć że wartości zmiennej można modyfikować w zależności od potrzeb.

Edytowane 16 Sierpnia przez kojacek

[Robert11]

Dziękuję o to mi chodziło 

[Robert11]

Prawię o to chodziło tylko ja mam 30 różnych nazw i chciałem je wypisać w pliku wsadowym dlatego prosiłem o nie zapętlenie tego pliku

[Robert11]

Chodzi mi o nazwy bloków 

[kojacek]

(defun %aaa ()
  (foreach %
    (list "ENE" "DUE" "RABE" "POLKNAL" "CHINCZYK" "NAME")
    (progn
      (setq *ATT-LIST* (list % "SYMBOL" "LPS"))
      (C:ATR-ZMIANA)
    )
  )
)

 

[Robert11]

Dziękuję w wolnej chwili zajrzę do tego