_

Uzgodnij właściwości - blok dynamiczny

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

Uzgodnij właściwości - blok dynamiczny

Postprzez CAD Project » wrz 13, 2018 19:17

Witajcie forumowicze,

Poszukuję lisp-a który by działał następująco.
Mam wstawione do rysunku dwa bloki "A" oraz "B".
1.
Chciałbym podmienić blok "A" blokiem "B" w taki sposób aby punkt wstawiania, skala bloku, obrót itd został zaczerpnięty z bloku "A" i w to miejsce wstawiony blok "B" taką samą skalą, obrotem itd jak był wcześniej blok "A".
2.
I teraz chciałbym aby odczytać wszystkie parametry bloku dynamicznego "A" (widoczności , wartości odległości itd) i wstawić je (ustawić) w bolku "B" jeśli dany parametr występuje w bloku "B", jeśli nie powinien go pominąć.

Przykładowo blok "A" miał parametry : wysokość = 10, szerokość = 15 oraz widoczność: zakreskowany = TAK
Blok "B" ma parametry: wysokość oraz widoczność: zakreskowany.
Wstawiony blok "B" w miejsce bloku "A" powinien mieć ustawione parametry : wysokość =10 oraz widoczność: zakreskowany = TAK.
Parametr bloku "A" szerokość powinien zostać pominięty ponieważ nie ma takiego parametry blok "B".

Co do pkt.1 to znalazłem odpowiednie narzędzi o tyle z pkt.2 nawet z pomocą CADPL-packa nie potrafię sobie poradzić.

Czy ktoś byłby chętny pomóc ?
CAD Project
 
Posty: 21
Dołączył(a): lis 11, 2010 21:18

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez kojacek » wrz 13, 2018 19:49

CAD Project napisał(a):<ciach>...
Co do pkt.1 to znalazłem odpowiednie narzędzi o tyle z pkt.2 nawet z pomocą CADPL-packa nie potrafię sobie poradzić.

Czy ktoś byłby chętny pomóc ?


Mając w Pack'u te dwie funkcje niedasie :?:

cd:BLK_GetDynamicProps
cd:BLK_SetDynamicProps
Avatar użytkownika
kojacek
 
Posty: 5453
Dołączył(a): paź 03, 2005 20:17

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez CAD Project » wrz 13, 2018 19:55

Kojacku nie napisałem że się nie da tylko nie potrafię.
Potrafię ustawić jeden parametr dynamiczny.

Mam problem ze składnią, żeby w jakiejś pętli przeszukał wszystkie parametry bloku "A" i ustawić do bloku "B".

Konkretny jeden parametr potrafię ustawić natomiast nie wiem ile parametrów może mieć blok "A" i blok "B" więc domyślam się że musi być jakaś pętla i jeśli nie znajdzie parametru bloku "A" w bloku "B" to zacznie sprawdzać kolejny parametr aż do końca.
CAD Project
 
Posty: 21
Dołączył(a): lis 11, 2010 21:18

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez kojacek » wrz 13, 2018 20:27

CAD Project napisał(a):Kojacku nie napisałem że się nie da tylko nie potrafię.
Potrafię ustawić jeden parametr dynamiczny.

Mam problem ze składnią, żeby w jakiejś pętli przeszukał wszystkie parametry bloku "A" i ustawić do bloku "B".

Konkretny jeden parametr potrafię ustawić natomiast nie wiem ile parametrów może mieć blok "A" i blok "B" więc domyślam się że musi być jakaś pętla i jeśli nie znajdzie parametru bloku "A" w bloku "B" to zacznie sprawdzać kolejny parametr aż do końca.


To nie ma znaczenia. Piękno list polega na nieznajomości ich długości. Bardzo krótki "kurs LISP-a" z użyciem Pack'a zatem. W wielkim skrócie. Wskazujesz blok źródłowy:

Kod: Zaznacz cały
(setq a (cd:BLK_GetDynamicProps (car (entsel)) nil))

a wywołanie zwraca np. taką listę:
Kod: Zaznacz cały
'(("Width" . 89.0)("Height" . 245.0)("Name" . "Timber"))


Potem wybierasz blok docelowy:
Kod: Zaznacz cały
(setq b (car (entsel)))

i masz np:
Kod: Zaznacz cały
<Nazwa elementu: 1d8486b36d0>


zatem lista jego właściwości to wynik wywołania:
Kod: Zaznacz cały
(setq c (mapcar 'car (cd:BLK_GetDynamicProps b nil)))

a może mieć taką wartość:
Kod: Zaznacz cały
'("Width" "Height")

teraz (na koniec) wywołanie:
Kod: Zaznacz cały
(foreach % a
  (if
    (member (car %) c)
    (cd:BLK_SetDynamicProps b (car %)(cdr %))
  )
)


ustawia w bloku b tylko właściwości Width i Height....

;)
Avatar użytkownika
kojacek
 
Posty: 5453
Dołączył(a): paź 03, 2005 20:17

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez CAD Project » wrz 13, 2018 20:53

Dziękuję kojacku.
Muszę bardziej zgłębić temat funkcji "mapcar" i "foreach" bo widzę że mam braki.

Gdzie musiałbym wkleić program "testblok" do programu "BRE" żeby to zadziałało jedno z drugim ? Czy to jest wogóle możliwe ?
Przyznam szczerze, że program "BRE" to muszę siąść tydzień żeby to zrozumieć.

Kod: Zaznacz cały
(defun c:testblok()
(setq a (cd:BLK_GetDynamicProps (car (entsel)) nil))
(setq b (car (entsel)))
(setq c (mapcar 'car (cd:BLK_GetDynamicProps b nil)))
      (foreach % a
      (if
        (member (car %) c)
        (cd:BLK_SetDynamicProps b (car %)(cdr %))
      ))

  );end defun



Kod: Zaznacz cały
(defun c:BRE (/ *error* blk f ss temp)
  ;; Replace multiple instances of selected blocks (can be different) with selected block
  ;; Size and Rotation will be taken from original block and original will be deleted
  ;; Required subroutines: AT:GetSel
  ;; Alan J. Thompson, 02.09.10

  (vl-load-com)

  (defun *error* (msg)
    (and f *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))
    )
  )

  (if
    (and
      (AT:GetSel
        entsel
        "\nSelect replacement block: "
        (lambda (x / e)
          (if
            (and
              (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
              (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
              (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
            )
             (setq blk (vlax-ename->vla-object (car x)))
          )
        )
      )
      (princ "\nSelect blocks to be repalced: ")
      (setq ss (ssget "_:L" '((0 . "INSERT"))))
    )
     (progn
       (setq f (not (vla-startundomark
                      (cond (*AcadDoc*)
                            ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                      )
                    )
               )
       )
       (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
         (setq temp (vla-copy blk))
         (mapcar (function (lambda (p)
                             (vl-catch-all-apply
                               (function vlax-put-property)
                               (list temp p (vlax-get-property x p))
                             )
                           )
                 )
                 '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
                   ZEffectiveScaleFactor
                  )
         )
         (vla-delete x)
       )
       (vla-delete ss)
       (*error* nil)
     )
  )
  (princ)
)

(defun AT:GetSel (meth msg fnc / ent good)
  ;; meth - selection method (entsel, nentsel, nentselp)
  ;; msg - message to display (nil for default)
  ;; fnc - optional function to apply to selected object
  ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
  ;; Alan J. Thompson, 05.25.10
  (setvar 'errno 0)
  (while (not good)
    (setq ent (meth (cond (msg)
                          ("\nSelect object: ")
                    )
              )
    )
    (cond
      ((vl-consp ent)
       (setq good (cond ((or (not fnc) (fnc ent)) ent)
                        ((prompt "\nInvalid object!"))
                  )
       )
      )
      ((eq (type ent) 'STR) (setq good ent))
      ((setq good (eq 52 (getvar 'errno))) nil)
      ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
    )
  )
)

CAD Project
 
Posty: 21
Dołączył(a): lis 11, 2010 21:18

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez ziele_o2k » wrz 14, 2018 01:21

Pozwolę sobie wrzucić moje narzędzie, które kiedyś na szybko napisałem i nigdy nie podkręciłem (bo działa). Poza właściwościami bloku (zwykłymi i dynamicznymi) mapuje jeszcze atrybuty. Zobacz jak łatwo (z bibliotekami cadpackowymi i LeeMaca) rozszerzyłem oryginalne BRE alanjt'a o dodatkowe możliwości.
Kod: Zaznacz cały
;;; Replace multiple instances of selected blocks (can be different) with selected block
;;; Size and Rotation will be taken from original block and original will be deleted
;;; Required subroutines: AT:Entsel
;;; Alan J. Thompson, 02.09.10
;;; mod by ziele_o2k 25.05.2018
(defun c:gtBRE (/ *error* #Block #SS #Temp _app_typ _atts)
(defun LM:setdynprops ( blk lst / itm )
    (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst))
    (foreach x (vlax-invoke blk 'getdynamicblockproperties)
        (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst))
            (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x))))
        )
    )
)
  (setq *error* (lambda (x) (cd:SYS_UndoEnd) ))
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  (cd:SYS_UndoBegin)
  (setq _app_typ (STRCASE(car(cd:SYS_AcadInfo))))
  (cond
    ((and (setq #Block (AT:Entsel nil "\nWskaż blok żródłowy: " '("LV" (0 . "INSERT")) nil))
          (princ "\nZaznacz bloki do zmiany: ")
          (setq #SS (ssget "_:L" '((0 . "INSERT"))))
     ) ;_ and
     (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
       ;; copy original block
       (setq #Temp (vla-copy #Block))
       ;; put new values
       (mapcar '(lambda (p)
                  (vl-catch-all-apply 'vlax-put-property (list #Temp p (vlax-get-property x p)))
                ) ;_ lambda
                (if (= _app_typ "ZWCAD")
               (list 'Insertionpoint 'Rotation 'XScaleFactor 'YScaleFactor
                     'ZScaleFactor 'Layer 'truecolor
                    ) ;_ list
               (list 'Insertionpoint 'Rotation 'XEffectiveScaleFactor 'YEffectiveScaleFactor
                     'ZEffectiveScaleFactor 'Layer 'truecolor
                    ) ;_ list
                  )
       ) ;_ mapcar
       (if (setq _atts (cd:BLK_GetAttsVLA x))
         (foreach % _atts
            (cd:BLK_SetAttValueVLA #Temp (car %) (cdr %))
         )
       )
       (if (setq _props (cd:BLK_GetDynamicProps x nil))
         (LM:setdynprops #Temp _props)
       )
       ;; delete old block
       (vl-catch-all-apply 'vla-delete (list x))
     ) ;_ vlax-for
     (vl-catch-all-apply 'vla-delete (list #SS))
    )
  ) ;_ cond
  ;(*error* nil)
  (cd:SYS_UndoEnd)
  (princ)
) ;_ defun





(defun AT:Entsel (nest msg flt kwrd / vlaLck flt _match ent good)
  ;; nest - Entsel or NEntselP (T for NEntselP, nil for Entsel)
  ;; msg  - Display message (if nil, "\nSelect object: " is used)
  ;; flt  - Filter list (DXF SSGet style filter or a lambda express to match) nil if not required
  ;;                   "V" as first item in list to convert object to VLA-Object
  ;;                   "L" as first item in list to ignore locked layers
  ;; kwrd - Kewords to match instead of object selection (nil if not required)
  ;; Example: (AT:Entsel nil "\nSelect line [Settings]: " '("LV" (0 . "LINE")(8 . "~0")) "Settings")
  ;; Example: (AT:Entsel nil nil (list "V" (lambda (x) (eq "TEXT" (cdr (assoc 0 (entget (car x))))))) nil)
  ;; Copyright© Alan J. Thompson, 04.16.09
  ;; Updated: Alan J. Thompson, 06.04.09 (changed filter coding to work as ssget style dxf filtering)
  ;; Updated: Alan J. Thompson, 09.07.09 (added option to ignore locked layers and convert object to VLA-OBJECT
  ;; Updated: Alan J. Thompson, 09.18.09 (fixed 'missed pick' alert)
  ;; Updated: Alan J. Thompson, 06.03.10 (complete rewrite and added option to apply lambda function to selection)
  (setvar 'errno 0)
  ;; if available, sort out filters (flt) to see what applies
  (if (vl-consp flt)
    (progn
      ;; first item string (ignore locked layers, convert to vla-object)
      (and (eq (type (car flt)) 'STR)
           (setq vlaLck (car flt)
                 flt    (cdr flt)
           )
      )
      ;; flt equal to DXF list
      (cond ((vl-consp (car flt))
             (setq _match (lambda (x)
                            (not
                              (vl-position
                                nil
                                (mapcar
                                  (function
                                    (lambda (f)
                                      (wcmatch
                                        (strcase
                                          (vl-princ-to-string
                                            (cdr (assoc (car f) (entget (car ent))))
                                          )
                                        )
                                        (strcase (vl-princ-to-string (cdr f)))
                                      )
                                    )
                                  )
                                  flt
                                )
                              )
                            )
                          )
             )
            )
            ;; flt equal to function
            ((eq (type (car flt)) 'SUBR) (setq _match (car flt)))
      )
    )
  )
  (while (not good)
    (and kwrd (initget 0 kwrd))
    (setq ent ((cond (nest nentselp)
                     (entsel)
               )
                (cond (msg)
                      ("\nSelect object: ")
                )
              )
    )
    (cond
      ((vl-consp ent)
       ;; ignore locked
       (and
         (eq (type vlaLck) 'STR)
         (wcmatch (strcase vlaLck) "*L*")
         (eq 4
             (logand 4
                     (cdr
                       (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 (entget (car ent)))))))
                     )
             )
         )
         (setq good (setq ent (prompt "\nObject on locked layer!")))
       )
       ;; DXF list to match or function
       (and (vl-consp ent)
            _match
            (or (_match ent) (setq good (setq ent (prompt "\nInvalid object!"))))
       )
       ;; convert to vla-object
       (if (and (vl-consp ent) (eq (type vlaLck) 'STR) (wcmatch (strcase vlaLck) "*V*"))
         (setq good (vlax-ename->vla-object (car ent)))
         (setq good ent)
       )
      )
      ((eq (type ent) 'STR) (setq good ent))
      ((setq good (eq 52 (getvar 'errno))) nil)
      ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
    )
  )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 735
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez CAD Project » wrz 14, 2018 09:03

Dziękuję, działa wręcz idealnie tylko w jednym miejscu jest problem.
Jeśli już wstawiony blok ma skalę x=-1 to wstawia w jego miejsce program blok ze skalą x=1 co powoduje że blok jest wstawiony w "mirrorze".
Co musiałbym zmienić w kodzie żeby tą przypadłość wyeliminować ?
CAD Project
 
Posty: 21
Dołączył(a): lis 11, 2010 21:18

Re: Uzgodnij właściwości - blok dynamiczny

Postprzez CAD Project » wrz 14, 2018 12:38

Sprawdziłem i tak:
- na blokach zwykłych działa poprawnie i ustawia skalę X bloku wstawianego zgodnie ze skalą X pobraną ze źródła. Czyli jeżeli blok ma skalę x=-1 to wstawiany w jego miejsce blok ma też skalę x=-1,
- na blokach dynamicznych przypisuje wszystkim wstawianym blokom skalę x=1
CAD Project
 
Posty: 21
Dołączył(a): lis 11, 2010 21:18


Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników