AutoCAD, AutoLISP

Opis bloku

O blokach pisałem już niejednokrotnie. Za pewnik można przyjąć że, nie raz jeszcze do nich będę powracał w przyszłości. Dziś o pewnej właściwości bloków – o opisie. Właściwość ta, jak zauważyłem, nie cieszy się zbyt dużym zainteresowaniem wśród użytkowników, a szkoda, bowiem mądrze zaplanowana definicja bloku, z wykorzystaniem opisu właśnie, daje wiele korzyści. Popatrzmy na animację poniżej:

Animacja przedstawia działanie krótkiego programu lispowego, służącego do tworzenia etykiet opisujących blok, zestawień, legend itp. Jak widać po wybraniu bloku i wskazaniu punktu wstawienia, tworzony jest automatycznie tekst którego zawartością jest… no właśnie – opis bloku.

Opis bloku można utworzyć podczas definiowania bloku w oknie dialogowym polecenia BLOK (_BLOCK):

Tak samo, podczas edycji bloku (w edytorze bloku), można dodać lub zmienić istniejący opis, na palecie właściwości:

Opis bloku znajduje się w definicji bloku (czyli jest jeden dla wszystkich odniesień). W rysunkowej bazie danych zajmuje kod 4 danych DXF (właściwość Comments w modelu ActiveX). Jest to łańcuch tekstowy. Jeżeli jest to tekst wieloliniowy, kolejne wiersze rozdzielane są znakami „\r\n” (return\newline). Tę cechę wykorzystuję do opisów bloków dynamicznych, tak jak to widać na poniższym przykładzie. Ponieważ opis bloku jest tylko jeden, a zdefiniowanych jest kilka wartości parametru widoczności, przyjąłem zasadę opisu dla każdego stanu w osobnym wierszu.

Działanie programu, dla bloków których opis składa się z wielu linii tekstu widać poniżej. Po wybraniu bloku i wskazaniu punktu wstawienia tekstu, uruchamiane jest dynamicznie tworzone okno dialogowe, w którym można wybrać odpowiednią linię opisu bloku. Dla wygody (nie jest to wymóg konieczny) każda linia opisu zaczyna się tak jak nazwa stanu widoczności.

Oczywiście po wstawieniu tekstu, można go (jak widać) dowolnie edytować.

Powyższe przykłady ilustrują wykorzystanie krótkiego makra LISP-owego. Pozwala ono wyodrębnić ze wskazanego bloku informację (jeśli istnieje) zawartą jako jego opis, i utworzenie z niej tekstu we wskazanym punkcie. Definicja polecenia BLCOM wygląda tak:


; ==================================================================== ;
; blcom.lsp - kojacek (2017)                                           ;
;             Polecenie BLCOM tworzy tekst z opisem bloku              ;
;             (wlasciwosc Comments obiektu jezeli ja posiada)          ;
; ==================================================================== ;

; -------------------------------------------------------------------- ;
; zmienna globalna -> tekst wielkimi literami:
(setq *jk-BlockCommBig* T)
; -------------------------------------------------------------------- ;
(defun C:BLCOM (/ s d c n l a i r o)
  (if
    (and
      (setq s (entsel "\nWybierz blok: "))
      (= "INSERT" (cdr (assoc 0 (setq d (entget (car s))))))
    )
    (progn
      (setq n (vla-get-EffectiveName
                (vlax-ename->vla-object (car s)))
      )
      (if
        (/= "" (setq c
                 (vla-get-Comments (vla-item (cd:ACX_Blocks) n))
               )
        )
        (progn
          (setq l (cd:STR_Parse
                    (vl-list->string
                      (vl-remove 13 (vl-string->list c))
                    )
                    "\n" nil
                  )
                a (cdr (assoc 8 d))
          )
          (if
            (setq p (getpoint "\nPunkt wstawienia opisu: "))
            (progn
              (setq i 0)
              (if
                (= (length l) 1)
                (setq r (nth i l))
                (setq r (nth
                  (cd:DCL_StdListDialog l i
                    "Opis bloku" "Wybierz: " 50 12 1 11
                    (list "&OK" "") nil T T nil) l
                  )
                )
              )
              (progn
                (cd:SYS_UndoBegin)
                (if *jk-BlockCommBig* (setq r (strcase r)))
                (setq o
                  (cd:ACX_AddText
                    (cd:ACX_ASpace) r p (getvar "TEXTSIZE") 0
                  )
                )
                (cd:ACX_SetProp  o (list (cons "Layer" a)))
                (cd:SYS_UndoEnd)
              )
            )
            (princ "\nNie wskazano punktu. ")
          )
        )
        (princ "\nBlok nie ma opisu. ")
      )
    )
    (princ "\nNie wskazano bloku. ")
  )
  (princ)
)
; ==================================================================== ;
(princ)

Z braku miejsca, przedstawiony tutaj program, wykorzystuje wiele wartości domyślnych (styl i wysokość tekstu – zmienne systemowe TEXTSTYLETEXTSIZE), można sobie wyobrazić jego rozbudowę o w pełni konfigurowalne okno dialogowe, do tych ustawień. LISP-owa zmienna globalna o nazwie *jk-BlockCommBig*, gdy ma wartość różną od nil, zapewnia tworzenie tekstu wielkimi literami. Program korzysta z biblioteki CADPL-Pack.

Tworzenie opisów bloków, nie jest konieczne dla wszystkich ich definicji. W wielu przypadkach gdy taki opis niczego nie wnosi, nie ma potrzeby ich wprowadzania. Na przykładach pokazałem że, warto je jednak stosować w sytuacjach gdzie oprócz funkcji informacyjnych, można je jeszcze wykorzystać do opisu rysunku. Pozwala to zaoszczędzić czas (nie piszemy niczego dwa razy), unikać błędów (niepasujące, błędne opisy), i zachowuje standardy i spójnosć (taki sam opis dla wszystkich takich samych elementów). To wszystko, w końcowym efekcie świadczy o perfekcji i profesjonalizmie tworzącego rysunek.

( . . . )

Reklamy
AutoLISP

Zamiana MLINE na LWPOLYLINE

Ponownie o konwersjach obiektów. Tym razem o zamianie obiektów będących multiliniami na zwyczajne polilinie. Problem dość dawno, omawiany  TUTAJ, znaleziony podczas ostatnich „porządków” i myślę, wart przypomnienia. Nawiasem mówiąc, ostatnio znalazłem dużo nieco już przykurzonych różnego rodzaju moich lisp-ów, w różnym stadium wydziobania. Część być może, zostanie tu opisana. Wracając do narzędzia konwertującego. Zdefiniowane jest polecenie MTOL, które wymaga wybrania dowolnych obiektów typu MLINE, z niezamkniętych warstw. Jedynym ograniczeniem jest wybór multilinii o dwóch elementach w jednym segmencie – innymi słowy wielolinii podwójnej. Wybrane obiekty zamieniane są na polilinie, której szerokość odpowiada skali multilinii. Widać to na animacji poniżej:

Przygotowując opis tego makra, poprawiłem jego działanie, tak aby poprawnie zamieniał multilnie zamknięte:

Do poprawnego działania konieczne jest załadowanie biblioteki CADPL-Pack, a definicja polecenia MTOL wygląda tak:


; ==================================================================== ;
;;; mtol.lsp by kojacek 30-03-2012             
;;; mod: 30-10-2017  
; ==================================================================== ;
(if (not cd:ACX_ADoc)(load "CADPL-Pack-v1.lsp" -1))
; -------------------------------------------------------------------- ;
(defun C:MTOL (/ l)
  (if
    (setq l (jk:M2L_getSs))
    (progn
      (cd:SYS_UndoBegin)
      (foreach % l (jk:M2L_ConvertMline %))
      (cd:SYS_UndoEnd)
    )
    (princ "\nNic nie wybrano. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(defun jk:M2L_ConvertMline (en / d la pt sc ju dl ns vo obj cl)
  (setq d (entget en)
        pt (cd:DXF_Massoc 11 d)
        la (cdr (assoc 8 d))
        sc (cdr (assoc 40 d))
        ju (cdr (assoc 70 d))
        cl (= 2 (logand 2 (cdr (assoc 71 d)))) ; <- mod 30-10-2017
        dl (jk:M2L_DefLines (cdr (assoc 340 d)))
  )
  (if
    (eq (abs (caar dl))(abs (caadr dl)))
    (progn
      (setq ns (* sc (abs (caar dl)))
            obj (entmakex
                  (append
                    (list
                      (cons 0 "LWPOLYLINE")
                      (cons 100 "AcDbEntity")
                      (cons 100 "AcDbPolyline")
                      (cons 8 la)
                      (cons 62 (cadar dl))
                      (cons 90 (length pt))
                      (cons 70 0)
                    )
                    (mapcar
                      (function
                        (lambda (%)
                          (cons 10 (trans % 1 0))
                        )
                      )
                      pt
                    )
                  )
                )
      )
      (if obj
        (progn
          (setq vo
            (if
              (= 1 ju)
              (vlax-ename->vla-object obj)
              (car
                (vlax-safearray->list
                  (vlax-variant-value
                    (vla-offset
                      (vlax-ename->vla-object obj)
                      (if (zerop ju) ns (* -1 ns))
                    )
                  )
                )
              )
            )
          )
          (if cl (vla-put-Closed vo :vlax-true)) ; <- mod 30-10-2017
          (if (not (equal obj (entlast)))(entdel obj))
          (cd:ACX_SetProp vo (list (cons "ConstantWidth" (* 2.0 ns))))
          (entdel en)
        )
      )
    )
  )
)
; -------------------------------------------------------------------- ;
(defun jk:M2L_getSs (/ s)
  (princ "\r Zamiana multilini na polilinie.")
  (if
    (setq s
      (cd:SYS_CheckError
        (list ssget "_:L" '((0 . "MLINE")(73 . 2)))
      )
    )
    (cd:SSX_Convert s 0)
  )
)
; -------------------------------------------------------------------- ;
(defun jk:M2L_DefLines (en / d i r)
  (setq d (entget en)
        i (cdr (assoc 71 d))
  )
  (repeat i
    (setq d (member (assoc 49 d) d)
          r (append
              (cons
                (list
                  (cdr (assoc 49 d))
                  (cdr (assoc 62 d))
                  (cdr (assoc 6 d))
                ) r
              )
            )
          d (cdr d)
    )
  )
  r
)
; -------------------------------------------------------------------- ;
(princ "\nPolecenie MTOL")
(princ)

 

( . . . )

AutoLISP

Przecinanie krzyżujących się linii – rozszerzenie

Temat programu do szybkiego przecinania krzyżujących się linii, nieco się rozrasta, stąd (stosunkowo szybko) drugi wpis. Będący (nawiasem mówiąc) odpowiedzią na poniższy komentarz:

W ten oto sposób powstał dodatkowy krótki kawałek kodu realizujący ten postulat. Zostało to zrealizowane w ten sposób – zdefiniowane jest nowe polecenie -PRZE, które po wywołaniu, w linii poleceń ma cztery opcje. Są to: możliwość ustawienia szerokości przerwy (przecięcia) linii, wywołanie wcześniej zdefiniowanych poleceń PRZER oraz PRZERM, i wyjście. Poniższa animacja ilustruje działanie:

Ustawienie szerokości przerwania, wymaga podania niezerowej i nieujemnej liczby, lub wskazania dwóch punktów, określających odległość. Opcja [Raz] wywołuje zdefiniowane wcześniej polecenie PRZER, a opcja [Wiele], polecenie PRZERM. Oba polecenia nie zostały zmienione, i jak poprzednio można je też wywoływać osobno. Pomimo tego że, rozszerzenie funkcjonalności polega tylko na dodaniu fragmentu kodu, dla ułatwienia prezentuję go w całości, z powtórzeniem kodu z poprzedniej wersji. Kod programu w całości pokazany jest poniżej:


; ==================================================================== ;
; schedit-tools.lsp by kojacek 1995,1997,2000,2005,2008,2015,2017      ;
; last-mod: 06-11-2017                                                 ;
; Definicja polecenia: -PRZ pozwala ustawic wielkosc przerwy, oraz wy- ;
; woluje PRZER i PRZERM jako opcje                                     ;
; ==================================================================== ;
(setq *jk-Schedit-Dist* 1.5)
; -------------------------------------------------------------------- ;
(defun C:-PRZ (/ r -getDist)
  (defun -getDist (/ r)
    (initget (+ 2 4 64))
    (setq r
      (getdist
        (strcat
          "Podaj wiekość przerwy <"
          (cd:CON_Real2Str (* 2.0 *jk-Schedit-Dist*) 2 nil)
          ">: "
        )
      )
    )
    (if r r (* 2.0 *jk-Schedit-Dist*))
  )
  (if (not *jk-Schedit-Trim*)(setq *jk-Schedit-Trim* "Wiele"))
  (if
    (setq r
      (cd:USR_GetKeyWord
        (strcat
          "\nPrzerwanie linii (przerwa= "
          (cd:CON_Real2Str (* 2.0 *jk-Schedit-Dist*) 2 nil)
          ")"
        )
        '("Przerwa" "Raz" "Wiele" "Koniec")
        *jk-Schedit-Trim*
      )
    )
    (cond
      ( (= r "Raz")(setq *jk-Schedit-Trim* r)(C:PRZER))
      ( (= r "Wiele")(setq *jk-Schedit-Trim* r)(C:PRZERM))
      ( (= r "Przerwa")
        (setq *jk-Schedit-Dist* (* 0.5 (-getDist)))
        (C:-PRZ)
      )
      (t (princ "\nAnulowano. "))
    )
    (princ "\nBłąd. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(defun C:PRZER (/ l e d p)
  (if
    (and
      (setq l (entsel "\nWskaż linię \"pod\" (do przerwania): "))
      (= (cdr (assoc 0 (setq d (entget (setq e (car l)))))) "LINE")
      (vlax-write-enabled-p e)
    )
    (progn
      (redraw e 3)
      (if
        (setq p (getpoint "\nPunkt przerwania: "))
        (progn
          (cd:SYS_UndoBegin)
          (jk:SCH_BreakLineDist e d p *jk-Schedit-Dist*)
          (cd:SYS_UndoEnd)
        )
        (progn 
          (redraw e 4)
	  (princ "\nNie wskazano punktu. ")
        )
      )
    )
    (princ "\nNie wskazano właściwego obiektu. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(defun C:PRZERM (/ l d e s g)
  (if
    (and
      (setq l (entsel "\nWskaż linię \"nad\": "))
      (= (cdr (assoc 0 (entget (setq e (car l))))) "LINE")
    )
    (progn
      (redraw e 3)
      (princ "\nLinie \"pod\" (do przerwania), ")
      (if
        (setq s (ssget '((0 . "LINE"))))
        (progn
          (setq g (cd:SSX_Convert s 0)
                e (vlax-ename->vla-object e)
          )
          (cd:SYS_UndoBegin)
          (foreach % g
            (if
              (vlax-write-enabled-p e)
              (jk:SCH_BreakLineDist
                %
                (entget %)
                (car
                  (LM:intersections e
                    (vlax-ename->vla-object %) acExtendNone
                  )
                )
                *jk-Schedit-Dist*
              )
            )
          )
          (cd:SYS_UndoEnd)
        )
      )
      (redraw (vlax-vla-object->ename e) 4)
    )
    (princ "\nNie wskazano właściwego obiektu. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(defun jk:SCH_BreakLineDist (Ob Dt Pt Ds / e s a o d la lb p1 p2)
  (if Pt
    (progn
      (setq s (cdr (assoc 10 Dt))
            e (cdr (assoc 11 Dt))
            a (angle s e)
            o (vlax-ename->vla-object Ob)
            d (mapcar
               '(lambda (%)
                  (cons % (vlax-get-property o %))
                )
                '("Layer" "Color" "LineType"
                  "LinetypeScale" "LineWeight")
              )
            p1 (polar Pt (+ pi a) Ds)
            p2 (polar Pt a Ds)
      )
      (setq la (cd:ACX_AddLine (cd:ACX_ASpace) s p1 T)
            lb (cd:ACX_AddLine (cd:ACX_ASpace) p2 e T)
      )
      (foreach % (list la lb)
        (mapcar
          '(lambda (%1)(vlax-put-property % (car %1)(cdr %1)))
          d
        )
      )
      (vla-delete o)
    )
    (princ "\rBłąd. Nie można wykonać przerwania. ")
  )
)
; -------------------------------------------------------------------- ;
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections (ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
        (vlax-method-applicable-p ob2 'intersectwith)
        (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
      (repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst)(cadr lst)(caddr lst)) rtn)
             lst (cdddr lst)
        )
      )
  )
  (reverse rtn)
)
; -------------------------------------------------------------------- ;
(princ)

Program w sesji zapamiętuje ostatnio wybrane opcje wyboru poleceń (Raz / Wiele) i wartość przerwy – przy ponownym wywołaniu polecenia, są one proponowane jako wartości domyślne.

( . . . )

AutoLISP

Przecinanie krzyżujących się linii

Przecinanie krzyżujących się linii to temat poruszony niedawno na forum CAD tutaj. Ogólnie zagadnienie  to doskonale nadaje się do automatyzacji w procesie tworzenia dokumentacji. Wykorzystanie odpowiedniego narzędzia zwalnia użytkownika z wykonywania powtarzalnych, nudnych i mało istotnych działań edycyjnych – osiągnięcie oczekiwanego efektu, powinien realizować program. Wyraźnie widać to na poniższym przykładzie – tworzenia przerwań krzyżujących się linii.

Zastosowanie przerwań linii na różnego rodzaju schematach ma na celu głównie zwiększenie ich czytelności, zwłaszcza przy dużym stopniu skomplikowania. Przedstawienie jednej linii „nad” innymi (znajdującymi się „pod” nią), ma charakter umowny i nie ma odzwierciedlenia w rzeczywistości. Taki sposób przedstawiania linii połączeń, stosowany był już w czasach ich ręcznego kreślenia. Nie ma żadnych zasad dotyczących sposobu stosowania takich przerwań, ogólnie trzeba przyjąć jako nadrzędne właśnie kryterium czytelności schematu. Dodać trzeba że, schludne, jasne i czytelne rysunki techniczne (w każdej branży), świadczą o profesjonalizmie ich twórcy.

Do szybkiego tworzenia jednolitych przerwań krzyżujących się linii napisałem w LISP-ie, dwie definicje poleceń: PRZER i PRZERM. Pierwsze z nich służy to wykonania szybkiego jednego, dwóch przerwań, we wskazanym punkcie. Po wywołaniu polecenia należy wskazać linię która ma zostać przerwana i punkt przerwania. Wygląda to tak:

Poniżej zaś, widać działanie polecenia PRZERM, służącego do „masowego” przecinania linii. Tutaj kolejność wyboru jest nieco inna. Na początku wybieramy linię która ma być „na wierzchu” (nieprzecinana), a następnie wybieramy linie (zwykle więcej niż jedna) do przerwania. W tym przypadku punkty przerwania znajduje program.

Definicje obu poleceń przedstawione są poniżej. Są tylko małym fragmentem zbioru narzędzi, które napisałem (przez wiele lat) na własny użytek do tworzenia i edycji wszelkiego rodzaju schematów technologicznych dowolnych instalacji, sprężonego powietrza, gazów technicznych itp. Przedstawiony program „wycina” przerwę o wielkości 3 jednostek – połowa tej wartości określa globalna zmienna o nazwie *jk-Schedit-Dist*. Oczywiście można ją ustawić na dowolną inną wartość. Kod programu wygląda tak:


; ==================================================================== ;
; schedit-tools.lsp by kojacek 1995,1997,2000,2005,2008,2015,2017      ;
; last-mod: 04-11-2017                                                 ;
; Definicje polecen: PRZER i PRZERM                                    ;
; ==================================================================== ;
(setq *jk-Schedit-Dist* 1.5)
; -------------------------------------------------------------------- ;
(defun C:PRZER (/ l e d p)
  (if
    (and
      (setq l (entsel "\nWskaż linię \"pod\" (do przerwania): "))
      (= (cdr (assoc 0 (setq d (entget (setq e (car l)))))) "LINE")
      (vlax-write-enabled-p e)
    )
    (progn
      (redraw e 3)
      (if
        (setq p (getpoint "\nPunkt przerwania: "))
        (progn
          (cd:SYS_UndoBegin)
          (jk:SCH_BreakLineDist e d p *jk-Schedit-Dist*)
          (cd:SYS_UndoEnd)
        )
        (progn 
          (redraw e 4)
	  (princ "\nNie wskazano punktu. ")
        )
      )
    )
    (princ "\nNie wskazano właściwego obiektu. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(defun C:PRZERM (/ l d e s g)
  (if
    (and
      (setq l (entsel "\nWskaż linię \"nad\": "))
      (= (cdr (assoc 0 (entget (setq e (car l))))) "LINE")
    )
    (progn
      (redraw e 3)
      (princ "\nLinie \"pod\" (do przerwania), ")
      (if
        (setq s (ssget '((0 . "LINE"))))
        (progn
          (setq g (cd:SSX_Convert s 0)
                e (vlax-ename->vla-object e)
          )
          (cd:SYS_UndoBegin)
          (foreach % g
            (if
              (vlax-write-enabled-p e)
              (jk:SCH_BreakLineDist
                %
                (entget %)
                (car
                  (LM:intersections e
                    (vlax-ename->vla-object %) acExtendNone
                  )
                )
                *jk-Schedit-Dist*
              )
            )
          )
          (cd:SYS_UndoEnd)
        )
      )
      (redraw (vlax-vla-object->ename e) 4)
    )
    (princ "\nNie wskazano właściwego obiektu. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(defun jk:SCH_BreakLineDist (Ob Dt Pt Ds / e s a o d la lb p1 p2)
  (if Pt
    (progn
      (setq s (cdr (assoc 10 Dt))
            e (cdr (assoc 11 Dt))
            a (angle s e)
            o (vlax-ename->vla-object Ob)
            d (mapcar
               '(lambda (%)
                  (cons % (vlax-get-property o %))
                )
                '("Layer" "Color" "LineType"
                  "LinetypeScale" "LineWeight")
              )
            p1 (polar Pt (+ pi a) Ds)
            p2 (polar Pt a Ds)
      )
      (setq la (cd:ACX_AddLine (cd:ACX_ASpace) s p1 T)
            lb (cd:ACX_AddLine (cd:ACX_ASpace) p2 e T)
      )
      (foreach % (list la lb)
        (mapcar
          '(lambda (%1)(vlax-put-property % (car %1)(cdr %1)))
          d
        )
      )
      (vla-delete o)
    )
    (princ "\rBłąd. Nie można wykonać przerwania. ")
  )
)
; -------------------------------------------------------------------- ;
;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections (ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
        (vlax-method-applicable-p ob2 'intersectwith)
        (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
      (repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst)(cadr lst)(caddr lst)) rtn)
             lst (cdddr lst)
        )
      )
  )
  (reverse rtn)
)
; -------------------------------------------------------------------- ;
(princ)

Ostatnie modyfikacje polegały na wyodrębnieniu kodu jako osobne narzędzie (na potrzeby tejże publikacji), optymalizacja (większa integracja z CADPL-Pack‚iem, który jest oczywiście niezbędny), i użycie funkcji LM:intersections, autorstwa Lee Mac’a, która jest bardziej uniwersalna, krótsza, wydajniejsza (czytaj: lepsza) niż moje dotychczasowe narzędzie służące do tego samego celu.

. . . )

AutoLISP

DBCOUNT – zliczanie bloków dynamicznych

Użytkownicy AutoCAD-a, z zainstalowanym Express Tool, z pewnością znają narzędzie o nazwie BCOUNT.  To sprytne narzędzie, jeśli dobrze pamiętam, znajduje się e ET chyba od samego początku. Nie rozpisując się – BCOUNT służy do:

Mimo swoich niezaprzeczalnych zalet BCOUNT, ma niestety pewną dość istotną przypadłość. Mianowicie – nie potrafi zliczyć wystąpień bloków dynamicznych. Bazuje bowiem tylko na nazwie bloku (właściwość Name), ignorując zupełnie cechę bloków dynamicznych, czyli nazwę efektywną (właściwość EffectiveName). Opisywałem to już TUTAJ.

W różnego rodzaju schematach, rysunkach złożeniowych, zestawieniach, gdzie precyzyjne określenie ilości wystąpień bloków (także dynamicznych) ma istotne znaczenie, niedogodność ta jest bardzo uciążliwa. Oczywiście z pomocą przychodzi LISP, który w magiczny sposób za pośrednictwem swych nawiasów potrafi czynić życie lepszym 😉 … W ten sposób powstało narzędzie o nazwie DBC. Działanie polecenia widać poniżej:

Wyboru bloku dokonuje się na dwa sposoby, które należy określić po wywołaniu polecenia. Pierwszy – przez wskazanie bloku, lub drugi – wybranie nazwy bloku z listy w oknie dialogowym. Wystąpienia określonego bloku mogą zostać następnie policzone albo dla utworzonego wyboru (wskazania), albo dla wszystkich w aktualnym obszarze, albo dla wszystkich w rysunku. Te opcje też określa się w linii poleceń. Dla każdego wyboru polecenie kończy się informacją o ilości wystąpień bloku.

Program wymaga załadowania biblioteki CADPL-Pack. Kod całości wygląda tak:


; ==================================================================== ;
; DynBlkCount.lsp by kojacek 2015/2017                                 ;
;                                                                      ;
; Polecenie DBC zlicza ilosc wystapien blokow dynamicznych             ;
;                                                                      ;
; ==================================================================== ;
(defun C:DBC (/ a s x _Sel _Dlg _Get)
  (defun _Sel (/ s d r)
    (if
      (not (setq s (car (entsel "\nWskaż blok dynamiczny: "))))
      (princ "\nNic nie wskazano. ")
      (if
        (not (= "INSERT" (cdr (assoc 0 (setq d (entget s))))))
        (princ "\nNie wskazano bloku. ")
        (if
          (zerop (getpropertyvalue s "IsDynamicBlock"))
          (princ "\nTo nie jest blok dynamiczny. ")
          (setq r (getpropertyvalue s "BlockTableRecord/Name"))
        )
      )
    ) r
  )
  (defun _Dlg (/ l r)
    (if
      (setq l (cd:BLK_GetDynBlockList))
      (if
        (setq d
          (cd:DCL_StdListDialog
            l 0
            "Zlicz bloki dynamiczne" "Wybierz blok:"
            30
            20
            2
            12
            (list "&OK" "&Anuluj")
            nil T T nil
          )
        )
        (setq r (nth d l))
        (princ "\nNic nie wybrano. ")
      )
      (princ "\nW rysunku nie ma bloków dynamicznych. ")
    )
  )
  (defun _Get (n / u f r i v)
    (setq f
      (if
        (= 1 (length (setq u (cd:BLK_GetDynBlockNames n))))
        (car u)
        (cd:STR_ReParse u ",`")
      )
          i (list (cons 0 "INSERT")(cons 2 f))
    )
    (if
      (setq r
        (cd:USR_GetKeyWord
          (strcat "\nBlok \"" (strcase n) "\"")
          '("Wybierz" "Aktualny obszar" "Cały rysunek" "Koniec")
          "Wybierz"
        )
      )
      (cond
        ( (= r "Wybierz")(setq v (ssget i)))
        ( (= r "Aktualny")
          (setq v
            (ssget "_x"
              (append i
                (list (cons 410 (getvar "CTAB")))
              )
            )
          )
        )
        ( (= r "Cały")(setq v (ssget "_x" i)))
        (t (princ "\nAnulowano. "))
      )
    ) v
  )
; -------------------------------------------------------------------- ; 
  (if
    (setq a
      (cd:USR_GetKeyWord
        "\nZlicz bloki dynamiczne"
        '("Wskaż" "Lista" "Koniec")
        "Wskaż"
      )
    )
    (progn
      (cond
        ( (= a "Wskaż")(if (setq s (_Sel))(setq x (_Get s))))
        ( (= a "Lista")(if (setq s (_Dlg))(setq x (_Get s))))
        (t (princ "\nAnulowano. "))
      )
      (if x
        (princ
          (strcat "\nZnaleziono: " (itoa (sslength x)) " bloków. ")
        )
      )
    )
    (princ "\nAnulowano. ")
  )
  (princ)
)
; -------------------------------------------------------------------- ;
(princ)

( . . . )

AutoLISP

Uzgodnij punkt wstawienia tekstu

Proste, krótkie i szybkie makro, pozwalające zmienić punkt wstawienia wybranych obiektów tekstowych, na pobrany (częściowo lub w całości) z obiektu źródłowego. Działaniem przypominające polecenie UZGWŁAŚCIWOŚCI (__MATCHPROP), ale dotyczącym tylko punktu wstawienia (kod 10 danych DXF obiektów TEXT i MTEXT). Makro powstało jako odpowiedź, na problem zgłoszony na forum CAD: Elevation tekstów. Choć problem dotyczył uzgodnienia tylko składowej Z punktu wstawienia tekstów, uznałem że, rozszerzenie możliwości zmiany każdej składowej (X, Y, Z osobno), oraz punktu w całości, jest całkiem dobrym pomysłem. Program działa tak:

Zdefiniowane polecenie CHELT, wymaga wybrania obiektu źródłowego (tekstu, lub tekstu wielowierszowego), z którego pobrany jest punkt wstawienia. Następnie po utworzeniu zbioru wskazań (także tekstów i / lub tekstów wierszowych), można w opcjach polecenia wybrać zakres zmiany. Są to składowe X Y i Z współrzędnej punktu wstawienia, lub tenże punkt w całości. W konsekwencji zmieniane jest położenie wybranych elementów w przestrzeni. Nawiasem mówiąc, jak widać oprócz rozwiązania zgłoszonego problemu – uzgodnienie poziomu (współrzędna Z obiektu), program pozwala na szybkie wyrównywanie tekstów w pionie i poziomie.

Kod programu przedstawiony jest poniżej:


; ------------------------------------------------------------------ ;
; Polecenie CHELT ustawia dla zbioru wskazan TEXT/MTEXT wspolrzedna  ;
; X / Y / Z lub XYZ z pobranego tekstu zrodlowego                    ;
; kojacek 2017                                                       ;
; ------------------------------------------------------------------ ;
(defun C:CHELT (/ e d s c v l -ch10)
  (defun -ch10 (e i v / d n)
    (setq d (cdr (assoc 10 (entget e))))
    (setq n
      (cond
        ( (= "X" i)(list v (cadr d)(caddr d)))
        ( (= "Y" i)(list (car d) v (caddr d)))
        ( (= "Z" i)(list (car d)(cadr d) v))
        (t v)
      )
    )
    (cd:ENT_SetDXF e 10 n)
  )
  (if
    (and
      (setq e (entsel "\nWybierz źródłowy TEXT lub MTEXT: "))
      (wcmatch (cdr (assoc 0 (setq d (entget (car e))))) "*TEXT")
    )
    (progn
      (redraw (car e) 3)
      (setq v (cdr (assoc 10 d)))
      (princ
        (strcat "\nZmiana współrzędnej wstawienia"
                " [X=" (cd:CON_Real2Str (car v) 2 nil)
                ", Y=" (cd:CON_Real2Str (cadr v) 2 nil)
                ", Z=" (cd:CON_Real2Str (caddr v) 2 nil)
                "]"
        )
      )
      (if
        (setq s (ssget "_:L" '((0 . "*TEXT"))))
        (if
          (setq c
            (cd:USR_GetKeyWord
              "\nUstal składową współrzędnej obiektów"
              '("X" "Y" "Z" "Wszystkie" "Koniec") "Z")
          )
          (if
            (= c "Koniec")
            (princ "\nAnulowano. ")
            (progn
              (setq l (cd:SSX_Convert s 0))
              (cd:SYS_UndoBegin)
              (foreach % l
                (cond
                  ( (= c "X")(-ch10 % c (car v)))
                  ( (= c "Y")(-ch10 % c (cadr v)))
                  ( (= c "Z")(-ch10 % c (caddr v)))
                  ( (= c "Wszystkie")(-ch10 % "W" v))
                  (t  nil)
                )
              )
              (cd:SYS_UndoEnd)
            )
          )
          (princ "\nAnulowano. ")
        )
        (princ "\nNie wybrano obiektów. ")
      )
      (redraw (car e) 4)
    )
    (princ "\nNie wskazano prawidłowego obiektu. ")
  )
  (princ)
)

Oczywiście do prawidłowego działania konieczne jest załadowanie biblioteki funkcji lispowych CADPL-Pack.

( . . . )

AutoLISP, CADPL-Pack

Usuwanie bloków zagnieżdżonych

Kolejny raz o blokach. Na definicję bloku składają się: nazwa bloku, punkt wstawienia, geometria (dowolne obiekty graficzne), oraz (opcjonalnie) definicje atrybutów. Elementy tworzące geometrię bloku, mogą być dowolnymi obiektami graficznymi, w tym również odniesieniami do bloków. W takim przypadku właśnie mamy do czynienia z blokami zagnieżdżonymi. Nie ma żadnych ograniczeń poziomu zagnieżdżenia bloków, jedynym ograniczeniem są wstawienia bloków, które odwołują się same do siebie. Stosowanie zagnieżdżeń bloków ma na celu głównie uproszczenie tworzenia złożonych bloków.

W sytuacji gdy istnieje potrzeba wprowadzenia dowolnej zmiany, na przykład usunięcia jakiegoś elementu z bloku, należy dokonać jego reedycji, czyli zmiany definicji bloku. Można wtedy skorzystać z edytora bloków – polecenie BEDYCJA (_BEDIT), lub ODNEDYCJA (_REFEDIT) umożliwiające edycję odnośnika lub definicji bloku bezpośrednio w bieżącym rysunku. Do usunięcia zagnieżdżeń bloków można też skorzystać z opisywanego tutaj programu.

Powyższa animacja pokazuje działanie prostego programu który napisałem już wiele lat temu (2012), w odpowiedzi na problem zgłoszony na forum cad.pl, dotyczący właśnie usunięcia bloków zagnieżdżonych. Zdefiniowane polecenie BLR, wymaga wskazania odniesienia do bloku, a następnie jeżeli w definicji występują wstawienia innych bloków, wyświetla okno dialogowe, w którym tworzona jest lista wszystkich takich wstawień. Każdy taki (zagnieżdżony) blok reprezentowany jest przez jego nazwę i ename. Po wybraniu (jednej lub więcej) pozycji listy i akceptacji okna, bloki są usuwane z definicji wskazanego bloku, a w konsekwencji ze wszystkich jego wstawień.

Tak samo, co widać na animacji powyżej, można usuwać bloki z kolejnego poziomu zagnieżdżenia bloków. W przedstawionym tu przykładzie blok, zawierający dwa wstawienia bloku zestawu części złącznych (fragmentu gwintu śruby, nakrętki, podkładki i łba śruby). Z kolei każdy ten element jest osobnym blokiem – tutaj blokiem dynamicznym (nazwy bloków anonimowych w oknie). Usunięcie dowolnego elementu graficznego z bloku zestawu, odzwierciedlone jest w każdym jego wstawieniu.

Kod programu wygląda tak:


; ------------------------------------------------------------------ ;
; Polecenie BLR usuwa ze wskazanego bloku bloki zagniezdzone. Wybor  ;
; (nazwa bloku + <ename> z listy w oknie dcl. Wymaga CADPL-Pack      ;
; kojacek 2012                                                       ;
;                                                                    ;
; forum cad.pl:                                                      ;
; -> http://forum.cad.pl/usuwanie-blokow-zagnie-d-onych-t79408.html  ;
; ------------------------------------------------------------------ ;
(defun C:BLR (/ in ld bn ln lb)
  (if
    (setq in
      (cd:USR_EntSelObj
        (list "\nWybierz blok: " "Należy wskazać blok."
              "Nic nie wybrano. " "To nie jest blok. " "")
        (list "INSERT") nil nil T
      )
    )
    (if
      (setq ld
        (vl-remove-if-not
          '(lambda (%)
             (= (cdr (assoc 0 (entget %))) "INSERT")
          )
          (cd:BLK_GetEntity
            (setq bn (cdr (assoc 2 (entget (car in)))))
            nil
          )
        )
      )
      (progn
        (setq ld
          (mapcar
            '(lambda (%)
               (cons
                 (strcat
                   (cdr (assoc 2 (entget %))) " "
                   (car (cd:CON_All2Str (list %) nil))) %
              )
            ) ld
          )
        )
        (if
          (setq res
            (cd:DCL_StdListDialog
              (setq ln (mapcar 'car ld))
              0 "Usuń bloki" "Wybierz:" 55 15 2 12
              (list "&Ok" "&Anuluj") T T nil nil
            )
          )
          (progn
            (cd:SYS_UndoBegin)
            (setq lb (mapcar 'cdr ld))
            (if
              (listp res)
              (foreach % res
                (vla-delete (vlax-ename->vla-object (nth % lb)))
              )
              (vla-delete (vlax-ename->vla-object (nth res lb)))
            )
            (vla-regen (cd:ACX_ADoc) acActiveViewport)
            (cd:SYS_UndoEnd)
          )
          (princ "\nNie usunięto bloków z definicji. ")
        )
      )
      (princ "\nW bloku nie ma bloków zagnieżdżonych. ")
    )
  )
  (princ)
)

Do prawidłowego działania potrzebne jest załadowanie biblioteki CADPL-Pack.

( . . . )