|
|
发表于 2003-7-3 12:39:00
|
显示全部楼层
;;試試這個擦除重复物件
;| Programmed by Dave Aguilar
DUPREM.LSP 1994 Onyx Software
This program creates an list of entity lists for all entities in the
drawing (using the first VERTEX for POLYLINES) and then compares each
entity list with the total list, building a new selection set of all
duplicate entries which are then erased.
it's not guarenteed but try it on a copy of a badly duplicated drawing
and see if it helps.
------------------------------------------------------------------------
------------------------------------------------------------------------
Modified by J. Tippit, SPAUG President 08/25/99
E-mail: cadpres@spaug.org
Web Site: http://www.spaug.org
1. Modified to work with R14 & 2000
2. Now prompts for 3 types of selection sets
3. Works on all types of entities (including LWPOLYLINES)
Large donations to SPAUG is appreciated. :)
------------------------------------------------------------------------
------------------------------------------------------------------------
|;
(defun CUPREM (/ F1 SLE SA CA TA LA LB ENTA EA TYPA A1 A2 A3 A4 SC
LTEST TES
)
(setvar "cmdecho" 0)
(setq F1 NIL
F1 0
)
;; Added by Jeff Tippit 08/25/99
;; Start
(or :GCHOICE (setq :GCHOICE "Set"))
(initget "Set Limits All")
;;; (setq SLE (getkword "\nSelect objects by election set, imits, or ntire database: "))
(setq SLE
(getkword (strcat "\nType of selection [Set/Limits/All] : "
)
)
)
(if (not SLE)
(setq SLE :GCHOICE)
(setq :GCHOICE SLE)
)
(cond
((= SLE "Set") (setq SA (ssget)))
((= SLE "Limits")
(setq SA (ssget "c" (getvar "extmin") (getvar "extmax")))
)
((= SLE "All") (setq SA (ssget "X")))
)
(if (and SA (= (type SA) 'PICKSET) (not (zerop (sslength SA))))
(progn
(setq CA 0
TA (sslength SA)
LA NIL
LB NIL
)
(while (< CA TA)
(setq ENTA (ssname SA CA)
EA (cdr (entget ENTA))
TYPA (cdr (assoc 0 EA))
)
;; (if (= typa "OLYLINE") (progn
;; (setq entb (entnext enta) ea (cdr (entget entb)))
;; ))
;; Added by Jeff Tippit 08/25/99
;; Updated for R14 & 2000
;; Start
(setq A1 (assoc 5 EA))
(setq A2 (cons 5 ""))
(setq EA (subst A2 A1 EA))
(if (wcmatch (getvar "ACADVER") "*15*")
(progn
(setq A3 (assoc 330 EA))
(setq A4 (cons 330 ""))
(setq EA (subst A4 A3 EA))
)
)
(setq LA (cons ENTA LA)
LB (cons EA LB)
CA (+ CA 1)
)
)
(setq SC NIL
SC (ssadd)
LTEST LB
)
(setq CA 0)
(setq TES (car LTEST)
LTEST (cdr LTEST)
TA NIL
TA (length LTEST)
)
(while (/= TA 0)
(if (member TES LTEST)
(progn
(setq SC (ssadd (nth CA LA) SC))
(prompt "\nFound duplicate entity.")
(setq F1 (+ F1 1))
)
)
(setq CA (+ CA 1))
(setq TES (car LTEST)
LTEST (cdr LTEST)
TA (length LTEST)
)
)
(command "erase" SC "")
(redraw)
(prompt "\n")
(prin1 F1)
(prompt " duplicate entities erased.")
)
)
(princ)
)
(prompt
"\nType DUPREM to run. Delete duplicate entity routine Ver 2.0 loaded."
)
(princ) |
|
置顶卡
