[Autocad] Usuwanie zdublowanych obiektów
Prezes
Otrzymałem kilka plików dwg na których jak zauważyłem jest mnóstwo
wielokrotnie
ponakładanych na siebie tych samych obiektów.
Chciałbym troche podczyścić te pliki. Może ktoś ma jakiś sprytny lisp
który potrafiłby usunąć hurtem.zdublowane obiekty.
Z góry dziękuję i pozdrawiam
Prezes
JB
Zależy od typów elementów, częściowo przydatne polecenie -
'overkill' (express tools muszą być załadowane).
JB.
Prezes
Użytkownik "JB" napisał ...
> Zależy od typów elementów, częściowo przydatne polecenie -
>'overkill' (express tools muszą być załadowane).
Całkiem przydatne narzędzie - wielkie dzięki,
do pełni szczęścia brakuje możliwości
usuwania zdublowanych bloków bez rozbijania.
A niestety ja mam ich sporo na rysunkach.
pozdrawiam
Prezes
Lagoda
> Otrzymałem kilka plików dwg na których jak zauważyłem jest mnóstwo
> wielokrotnie
> ponakładanych na siebie tych samych obiektów.
> Chciałbym troche podczyścić te pliki. Może ktoś ma jakiś sprytny lisp
> który potrafiłby usunąć hurtem.zdublowane obiekty.
mam taki lisp "dupdel"
podesłać?
poniżej jego treść
_______________________________________________________
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
;*
*
;* DUPDEL.LSP by John F. Uhden
*
;* 2 Village Road
*
;* Sea Girt, NJ 08750
*
;*
*
;* This routine is made available on a "shareware" basis.
*
;* If you find it useful, and want to clear your conscience,
*
;* send the author an "attaboy" and a token $10.00.
*
;*
*
;* * * * * * * * * * < Please do not delete this heading > * * * * * * * * *
*
; Routine searches through drawing database and deletes all entities
; that are exact duplicate of an older entity.
; v1.1 (6-21-97) added:
; - option for reverse line comparison
; - option to include or exclude xdata
; - option for fuzz factor in numerical comparisons
; v1.2 (8-27-97) added:
; - options for object selection via layer(s)
; - MLINEs and MTEXT to entity types
(defun C:DUPDEL ( / del ss en en_n el_n ei en_i el_i elist etyp lay llist
ans1 ans2 ans3 n n1 i d done nohand xdata fuzz p10 p11
elr filter layers)
(gc)
(prompt "\nDUPDEL.LSP v1.2 (c)1993-1997, John F. Uhden, CADvantage")
(setvar "cmdecho" 1) ; dummy command to prevent Undoing of previous
command
(setq i 0 n1 0 d 0)
(if (> (getvar "cvport") 1)
(setq filter '((67 . 0)))
(setq filter '((67 . 1)))
)
(defun del ()
(setq ss (ssdel ei ss) d (1+ d) n (1- n) i (1- i))
(entdel ei)
)
(defun nohand (el)
(subst (cons 5 "0") (assoc 5 el) el)
)
(defun getent (e)
(if xdata (entget e '("*"))(entget e))
)
(initget "Arc Circle Dim Insert Line MLine MText PLine POint Solid TExt
TRace 3DFace *")
(prompt "\nEnter your choice...")
(prompt
"\nArc/Circle/Dim/Insert/Line/MLine/MText/PLine/POint/Solid/TExt/TRace/3DFace/<*>:
")
(setq ans1 (getkword))
(if (= ans1 "PLine")(setq ans1 "Polyline"))
(if (= ans1 "Dim")(setq ans1 "Dimension"))
(if (or (not ans1)(= ans1 "*"))
(setq etyp "entitie")
(setq etyp (strcase ans1)
filter (append (list (cons 0 etyp)) filter)
)
)
;;---------------------------------------------
;; Get the user's choice of selecting entities:
;;
(initget "All Layers Manually Picklayer")
(setq ans2 (getkword "\nSelection method,
All/Layers/Picklayer/<Manually>: "))
(prompt "\nExcluding all entities not in current space.")
(cond
((= ans2 "All")
(prompt (strcat "\nGetting ALL " etyp "s... "))
(setq ss (ssget "X" filter))
)
((= ans2 "Layers")
(setq ans2 (getstring "\nLayer names <*>: "))
(if (= ans2 "")(setq layer "*")(setq layer ans2))
(prompt (strcat "\nGetting all " etyp "s on selected layer(s)...
"))
(setq ss (ssget "X" (append (list (cons 8 layer)) filter)))
)
((= ans2 "Picklayer")
(prompt "\nSelect object to define layer name:")
(if (setq e (entsel))
(progn
(setq layer (cdr (assoc 8 (entget (car e)))))
(prompt (strcat "\nGetting all " etyp "s on layer " layer
"... "))
(setq ss (ssget "X" (append (list (cons 8 layer)) filter)))
)
)
)
((/= etyp "entitie")
(prompt (strcat "\nDon't worry about selecting objects that are not
" etyp "s."))
(prompt "\nThey will be filtered out of selection set.")
(setq ss (ssget filter))
)
(1 (setq ss (ssget filter)))
)
(if ss
(progn
(if (/= etyp "entitie")
(progn
(prompt (strcat "\n" (itoa (sslength ss)) " " etyp "s
found.\n"))
(setq elist (list etyp))
)
(progn
(prompt (strcat "\n" (itoa (sslength ss)) " entities
found.\n"))
(prompt "Sorting entities by type... ")
(while (< i (sslength ss))
(setq etyp (cdr (assoc 0 (entget (ssname ss i)))) i (1+
i))
(if (not (member etyp elist))(setq elist (cons etyp
elist)))
)
)
)
(initget "Yes No")
(setq xdata (= "Yes" (getkword "\nInclude 'XDATA' comparisons?
Yes/<No>: ")))
(initget 2)
(setq ans3 (getreal "\nFuzz factor for 'REAL comparisons (zero for
none) <0>: "))
(setq fuzz (if ans3 ans3 0.0))
(foreach etyp (reverse elist)
(prompt "\r
")
(prompt (strcat "\rSorting " etyp " entities by layer... "))
(if (> (length elist) 1)(setq ss (ssget "X" (list (cons 0
etyp)))))
(setq i 0 llist nil)
(while (< i (sslength ss))
(setq lay (cdr (assoc 8 (entget (ssname ss i)))) i (1+ i))
(if (not (member lay llist))(setq llist (cons lay llist)))
)
(foreach lay (reverse llist)
(setq ss (ssget "X" (list (cons 0 etyp)(cons 8 lay))) n
(sslength ss) i 0)
(prompt "\r
")
(while (> n 0)
(setq n (1- n) n1 (1+ n1))
(prompt (strcat "\rProcessing # " (itoa n1) " <" etyp " -
Layer: " lay "> "))
(setq i (1- n) en (ssname ss n)
el (nohand (cdr (getent en)))
el_n el
)
(while (> i -1)
(setq ei (ssname ss i) el_i (nohand (cdr (getent ei))))
(cond
((= etyp (cdr (assoc 0 el_i)) "LINE")
(setq p10 (cons 10 (cdr (assoc 11 el_n)))
p11 (cons 11 (cdr (assoc 10 el_n)))
elr (subst p10 (assoc 10 el_n) el_n)
elr (subst p11 (assoc 11 el_n) elr)
)
(if (or (equal el_n el_i fuzz)(equal elr el_i
fuzz))
(del)
(setq i (1- i))
)
)
((not (equal el_n el_i fuzz))(setq i (1- i)))
((and (assoc 66 el_n)(assoc 66 el_i))
(setq done nil en_n en en_i ei)
(while (not done)
(setq en_n (entnext en_n)
el_n (nohand (cdr (getent en_n)))
en_i (entnext en_i)
el_i (nohand (cdr (getent en_i)))
)
(cond
((equal el_n el_i fuzz))
((and (= (cdar el_n) "SEQEND")
(= (cdar el_i) "SEQEND"))
(setq done 1)
(del)
)
((not (equal el_n el_i fuzz))(setq done 1 i
(1- i)))
)
)
(setq el_n el)
)
(1 (del))
)
)
)
)
)
(prompt (strcat "\n" (itoa d) " duplicate entities deleted."))
(if (> d 0)
(progn
(redraw)
(prompt "\nYou may need REGEN to see remaining entities.")
)
)
)
(if (or (not ans1)(= ans1 "*"))
(prompt "\nNo entities found.")
(prompt (strcat "\nNo " etyp " entities found."))
)
)
(princ)
)
____________________________________________________________________
--
__________________________________________MAT_______
Prezes
Użytkownik "Lagoda" napisał ...
> mam taki lisp "dupdel"
Wielkie dzięki,
i z blokami sobie radzi.
Suuper ;-)
pozdrawiam
Prezes
Lagoda
> Wielkie dzięki,
John F. Uhden
--
__________________________________________MAT_______