Hidden lines...

Hi,

I have a drawing with about 1200 line and arc, and want to know
the best way to check for duplicated line.

I mean line hidden under another.

Thanks

Pat

 

Here is a routine that I use called "strip" that looks for and removes redundant lines. It has only one problem that I've
found..when representing a spring as an "X" or something ling like that, the routine will remove one line and not the other,
even if you don't want either removed.
R. Wink
=====================================================================
; STRIP.LSP Version 1.5 November 1, 1988
; By Jamie Clay
;
; This routine will examine a drawing for redundant LINEs and proceed to
; to remove them. This is designed to reduce the size of drawings created
; by AutoCAD and AutoShade's DXB output.
;
; The process is simple, STRIP takes a LINE and adds the start and end points
; to create a match value. It will then create a selection set based on a
; window defined by the start and end points. Using the match value it will
; find other identical lines in the selection set and erase them when found.
;
;
(defun c:STRIP (/ a b c erased count sum1 sum2 index)
(setq count 0)
(setq erased 0)
(setq a (entnext))
(while (/= (cdr (assoc 0 (entget a))) "LINE") ;WHILE #1 - Find first line
(setq a (entnext a))
) ;END WHILE #1
(setvar "cmdecho" 0)
(while a ; WHILE #2 - While A is true
(setq pass (strcat "Pass: " (rtos count 2 0)))
(grtext -2 pass)
(setq sum1 (sum a)) ; Create window points and verification sum
(setq b (ssget "w" ptA ptB)) ; Get all entities in this window
(if (not b) (setq b (ssget "c" ptA ptB)))
(ssdel a b) ; Remove first line from selection set
(if (> (sslength b) 0) ; IF #1 - If more than one line
(progn ; PROGN #1
(if (= (sslength b) 1) ; IF #2
(progn ; PROGN #2
(if (= sum1 (sum (ssname b 0))) ;IF #3
(progn ;PROGN #3
(command "erase" b "")
(setq erased (1+ erased))
(prompt (strcat "\rRemoved lines :" (rtos erased 2 0)))
) ; END PROGN #3
) ; END IF #3
) ; END PROGN #2
(progn ; PROGN #4
(setq index (1- (sslength b)))
(setq c 0)
(repeat (sslength b) ; REPEAT #1
(setq c (ssname b index))
(setq sum2 (sum c))
(if (= sum1 sum2) ; IF #4
(progn ; PROGN #5
(entdel c)
(setq erased (1+ erased))
(prompt (strcat "\rRemoved lines :" (rtos erased 2 0)))
(setq index (1- index))
) ; END PROGN #5
(setq index (1- index))
) ; END IF #4
) ; END REPEAT #1
) ; END PROGN #4
) ; END IF #2
(setq a (next a))
) ; END PROGN #2
(setq a (next a))
) ; END IF #1
(setq count (1+ count))
) ; END WHILE #2
(command "redraw")
(setvar "cmdecho" 1)
(prompt "\nFinished!")
(princ)
) ; END DEFUN

;======================= SUPPORTING DEFUNS =====================
;
; Find the next Line
(defun NeXT (x)
(setq b nil)
(setq x (entnext x))
(if x
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(while (/= (if x (cdr (assoc 0 (entget x))) "LINE") "LINE")
(setq x (entnext x))
)
)

)
(eval x)
)

; Create a match value based on the lines start and end points
(defun sum (x)
(setq ptA (cdr (assoc 10 (entget x))))
(if (assoc 11 (entget x))
(progn
(setq ptB (cdr (assoc 11 (entget x))))
(setq sumX (+ (+ (car ptA) (cadr ptA)) (+ (car ptB) (cadr ptB))))
)
)
)

; All done we is loaded
(prompt "\nC:STRIP - Loaded!")
(princ)


 

Sorry 'bout that. That routine is the only one I have and thought it might do the guy some good. After all, it works for me
and I was just trying to help the guy. If you have a better, more versatile one, please post it so I can add it to my
collection.
R. Wink

 

Thanks for the lisp

Pat

might do the guy some good. After all, it works for me

versatile one, please post it so I can add it to my

 

Unfortunately we don't know which AutoCAD Version you're using. If you
have the Express Tools and you want to KILL duplicated objects try the
overkill command.

Juergen

 

If the entities ARE EXACT DUPLICATES, you can use my deldbl.LSP on my site.
--

MichaelB
www.michaelbulatovich.com

(if they are different in any way, it WON'T catch it)

 

Not everyone pays the $$'s required to get the AutoDe$k's "dick in that ass" addons. A shared LISP routine that runs in R14
or R15 can, for the most part, be made to run in almost any other version and serve the majority of the people that visit
this forum.
Now, if you don't like the LISP I posted, post a better one..
R. Wink

 

;;NoDupchk.lsp
;; Jason Osgood
;; 15 Feb 92

=============================================

;; Utility functions
;;==================
;-----
;** Returns data from a keyed field whithin an association list
(DeFun Get (a b)
(Cdr
(Assoc a b)
)
)
;-----
;** Replaces the entity name in an association list with a 0
(DeFun NilName (edata)
(SubSt
(Cons -1 0) (Assoc -1 edata) edata)
)
;-----
;; Main Function
================
(DeFun CupChk ()
;/ pickset1 pickset2 i j ename1 ename2 edata1 edata2 layer)
(Prompt "\nSelecting entities...")
(SetQ pickset1
(SsGet "x")
);SetQ
(setq totlen (sslength pickset1))
(setq dupcnt nil)
(SetQ i -1) ;initialize first counter
;continue processing selection set until there are no more entities
(While
(SetQ ename1
(SsName pickset1
(SetQ i
(1+ i)
);SetQ
);SsName
);SetQ
;make sure the user knows something is happening
(Princ "\nFetching entity #")
(Princ i)
(princ " of : ")
(princ totlen)
(Cond
((SetQ edata1 (EntGet ename1))
(SetQ edata1 (NilName edata1) ;get entity data, drop entity name
etype (Get 0 edata1) ;get entity type
layer (Get 8 edata1) ;get entity layer
);SetQ
)
);cond
;select all entities of the same type on the same layer
(Cond
((SetQ pickset2
(SsGet "x"
(List
(Cons 0 etype) (Cons 8 layer)
);List
);SsGet
);SetQ
(SsDel ename1 pickset2) ;remove the "source" entity
;from the selection set
;let the user know something is happening
(Princ "\nNear matches: ")
(Princ
(SsLength pickset2)
);Princ
;intitialize second counter
(SetQ j -1)
(Princ " Comparing # ")
(While ;continue while all the following
;are true
(And ;always true
(SetQ k j) ;get the entity from the selection
set
(SetQ ename2
(SsName pickset2
(SetQ j
(1+ j)
);SetQ
);SsName
);SetQ
;this expression returns False (nil) if an entity was deleted
(Progn
;backspace over previous number
(While
(Progn
; (Princ "\010")
(princ "\n")
(Not
(ZeroP
(SetQ k
(/ k 10)
);SetQ
);ZeroP
);Not
);Progn
);While
(Princ j)
(SetQ edata2 (EntGet ename2)
edata2 (NilName edata2)
);SetQ
(Cond
;test to see if two entities are the same
((Equal edata1 edata2 1.0e-10)
;if so, delete the entity from the database and primary selection set
(EntDel ename2)
(SsDel ename2 pickset2)
(Princ " Duplicate deleted.")
;return False, break out of loop
nil
);Cond3a
;return True, continue porcessing
(T)
);Cond 3
);Progn
);And
);While
);Cond 2
);Cond 1
);While 1
;(ReDraw)
(Princ)
);________________________________End of File