Użytkownicy AutoCAD-a (choć nie tylko), są przekonani że jest to doskonałe narzędzie do tworzenia (rysowania i modelowania), a możliwości oprogramowania tych procesów, to już w ogóle bajka… Zgadzając się z tym w ogólności, poświęcę jednak dzisiejszy wpis… wymazywaniu obiektów, ze wskazaniem, że automatyzacja tegoż może być też niezłą zabawą…
Tak jak widać na (ruchomym) obrazie powyżej, chodzi o bardziej kontrolowany proces usuwania obiektów, niż jest to możliwe standardowo. Jest to wybór (wszystkich) obiektów ze wskazanej warstwy (przez wybranie jednego obiektu), z filrowaniem rodzaju obiektu (z możliwością zawężenia wyboru w oknie dialogowym). Normalnie, polecenie AutoCAD-a WYMAŻ (_ERASE), pozwala usunąć tylko wskazane obiekty. Rzecz jasna, utworzenie potrzebnego rozszerzonego zbioru wskazań (dla ERASE) może się odbywać na wiele sposobów (SELECT / QSELECT / SSGET), jednak zawsze wymaga to więcej pracy, niż skorzystanie z przedstawionego tu programu.
Jego działanie ogranicza się tylko do wskazania dowolnego obiektu w rysunku (z niezamkniętej warstwy) przeznaczonego do usunięcia. Program automatycznie tworzy zbiór wskazań wszystkich obiektów (z tej warstwy), dzieląc go na grupy znalezionych obiektów. Następnie (dynamicznie) tworzone jest okno dialogowe, w którym wyświetlana jest warstwa, oraz typy obiektów (z ilością występowania) w wycinkach typu toggle. Domyślnie wszystkie obiekty są wybrane (zaznaczone do usunięcia), wybór można jednak swobodnie ograniczyć.
Dla programujących w LISP-ie, ciekawostką będzie fakt wykorzystania jednej i tej samej funkcji obsługi wycinków toggle, dla nich wszystkich niezależnie od ich ilości (jest różna w zależności od rodzajów wybranych obiektów). Ta sama funkcja wykorzystana jest także do obsługi klawisza akceptującego [OK]. Mechanizm ten pozwala na kontrolowanie jego zachowania (aktywny / nieaktywny) zależnie od stanu wyboru wycinków wybierających. Jest to zilustrowane na grafice powyżej.
Wywołanie programu poleceniem: SER. Kod programu w całości przedstawiam poniżej:
; ---------------------------------------------------------------------------------- ;
; SmartERaser.lsp by kojacek 2022 ;
; ---------------------------------------------------------------------------------- ;
(defun C:SER ()(jk:SER_Main)(princ))
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_GetSelectLay (/ s)
(if
(setq s
(car (entsel "\nSelect object:"))
)
(cdr (assoc 8 (entget s)))
)
)
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_isLock (Lay)
(= :vlax-true
(vla-get-Lock
(vla-item
(cd:ACX_Layers) Lay
)
)
)
)
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_ssGet (Lay LObj / ss l)
(setq l
(list
(cons 8 Lay)
(cons 410 (getvar "CTAB"))
)
)
(if
(setq ss
(ssget "_x"
(if
(not LObj)
l
(append
(list
(cons 0 (cd:STR_ReParse LObj ","))
) l
)
)
)
)
(cd:SSX_Convert ss 0)
)
)
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_ObjLays (LObj)
(mapcar
'(lambda (%)
(cdr
(assoc 0 (entget %))
)
) LObj
)
)
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_ObjLaysItem (LObj / l :i)
(defun :i (o l / %1)
(setq %1 (vl-remove o l))
(strcat
o " ("
(itoa (- (length l)(length %1)))
")"
)
)
(setq l (LM:Unique LObj))
(acad_strlsort
(mapcar
'(lambda (%)
(:i % LObj)
) l
)
)
)
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_ObjDlgData (Lst / s k e l)
(setq s ":toggle{label=\""
k "\";key=\""
e "\";}"
)
(mapcar
'(lambda (%)
(strcat
s
%
k
(car (cd:STR_Parse % " " t))
e
)
) Lst
)
)
; ---------------------------------------------------------------------------------- ;
(defun jk:SER_Main (/ o l s i a r)
(if
(setq o (jk:SER_GetSelectLay))
(if
(jk:SER_isLock o)
(princ
(strcat "\nLayer \"" (strcase o) "\" is locked.")
)
(progn
(setq s (jk:SER_ssGet o nil)
l (jk:SER_ObjLays s)
i (length l)
)
(if
(= 1 i)
(jk:SER_Erase (list s) o)
(if
(setq r (jk:SER_Dialog l o))
(progn
(setq s (jk:SER_ssGet o r))
(jk:SER_Erase (list s) o)
)
(princ "\nCancelled.")
)
)
)
)
(princ "\nNothing selected.")
)
)
; ----------------------------------------------------------------------------------- ;
(defun jk:SER_Erase (Lst Lay / i)
(setq i (itoa (apply '+ (mapcar 'length Lst))))
(cd:SYS_UndoBegin)
(foreach % Lst
(foreach %1 % (entdel %1))
)
(cd:SYS_UndoEnd)
(princ
(strcat
"\n" i
" objects erased from \""
(strcase Lay)
"\" layer."
)
)
)
; ----------------------------------------------------------------------------------- ;
(defun jk:SER_Dialog (Lst Lay / a b d f i m r w x :c :o :r)
(defun :c ()
(mapcar
'(lambda (%)
(cons % (read (get_tile %)))
) x
)
)
(defun :o (/ j)
(setq j (apply '+ (mapcar 'cdr (:c))))
(mode_tile "accept"
(cond
( (zerop j) 1)
(t 0)
)
)
)
(defun :r (n)
(mapcar 'car
(vl-remove-if '(lambda (%)(zerop (cdr %))) n)
)
)
(setq l (jk:SER_ObjLaysItem Lst)
x (LM:Unique Lst)
a (jk:SER_ObjDlgData l)
i (itoa (1- (length a)))
b "Smart ERaser 1.00"
w "width=12;"
)
(cond
((not
(and
(setq f
(open
(setq m (vl-FileName-MkTemp nil nil ".dcl")) "w"
)
)
(foreach %
(list
(strcat
"ser:dialog{label=\"" b
"\";:column{:boxed_row{label=\"Layer:\";:text{label=\""
(strcase Lay)
"\";}}:row{:boxed_column{label=\"Objects to erase:\";"
(apply 'strcat a)
"}:column{:spacer{height=" i
";}:column{height=2;fixed_height=true;:ok_button{" w
"}:cancel_button{" w
"label=\"Cancel\";}}}}}}"
)
)
(write-line % f)
)
(not (close f))
(< 0 (setq d (load_dialog m)))
(new_dialog "ser" d ""
(cond
( %p )
( (quote (-1 -1)) )
)
)
)
)
)
( T
(foreach % x
(set_tile % "1")
(action_tile % "(:o)")
)
(action_tile "accept"
"(setq r (:c) %p (done_dialog 1))"
)
(action_tile "cancel"
"(setq %p (done_dialog 0))"
)
(start_dialog)
)
)
(if r (:r r))
)
; ---------------------------------------------------------------------------------- ;
; http://www.lee-mac.com/uniqueduplicate.html ;
; Unique - Lee Mac ;
; Returns a list with duplicate elements removed. ;
(defun LM:Unique ( l / x r )
(while l
(setq
x (car l)
l (vl-remove x (cdr l))
r (cons x r)
)
)
(reverse r)
)
; ---------------------------------------------------------------------------------- ;
(princ)
Oczywiście do poprawnego działania, konieczne jest wcześniejsze załadowanie CADPL-Pack’a.
To jest #212 wpis na blogu
( . . . )