Before there was overkill I wrote this(DEFUN C:SLX (/ A C CN DEL) ;B X Y Z XZ
(SETQ A (SSGET (LIST(CONS 0 "LINE")))
C (SSLENGTH A)CN 0 QQ nil B nil p nil cnt 0
B (REPEAT C (SETQ XZ (SSNAME A CN)
CN (1+ CN)
B (IF B (APPEND B (LIST XZ))(LIST XZ))
)
) ;REPEAT
) ;SETQ
(FOREACH Q B
(SETQ X (ENTGET Q)
Y (princ(CDR (ASSOC 10 X)) )
Z (CDR (ASSOC 11 X))
R (COND ((= (CAR Y)(CAR Z))
(LIST (CAR Y)(MAX(CADR Y)(CADR Z))(MIN(CADR Y)(CADR Z))))
((= (CADR Y)(CADR Z))
(LIST (CADR Y)(MAX(CAR Y)(CAR Z))(MIN(CAR Y)(CAR Z))))
(T (LIST(ANGLE Y Z) Y Z))
)
QQ (IF QQ (APPEND QQ (LIST R))(LIST R))
)
)
(FOREACH Q B
(SETQ X (ENTGET Q)
Y (CDR (ASSOC 10 X))
Z (CDR (ASSOC 11 X))
R (COND ((= (CAR Y)(CAR Z))
(LIST (CAR Y)(MAX(CADR Y)(CADR Z))(MIN(CADR Y)(CADR Z))))
((= (CADR Y)(CADR Z))
(LIST (CADR Y)(MAX(CAR Y)(CAR Z))(MIN(CAR Y)(CAR Z))))
(T (LIST Y Z))
)
r2 (cadr r) R3 (caddr r)
PL (PRINC R)
pl (princ(length (member (assoc (car r) QQ)QQ)))
ZZ(PROMPT "\n")
p (IF p
(cond ((MEMBER R p) (PROGN (ENTDEL Q)(setq cnt(1+ cnt)) (princ p)))
((> pl 0)(if (stest QQ r)(progn (entdel q)(setq cnt(1+ cnt)))(princ p) ))
(t (CONS R p))
)
(LIST R))
)
)(princ cnt)(princ "removed") (TERPRI)
)
(defun stest ( qq r / sa sb ss sx sy )
(setq sa (car r)
sb (assoc sa qq)
ss (member sb qq)
sx (cadr sb)sy (caddr sb)
)
(while (and (null stp) ss)
(setq stp (or (> sy r2 r3)(< sx r3 r2))
sb (assoc sa (cdr ss))
ss (member sb ss)
sc (length ss)
sx (cadr sb)sy (caddr sb)
)
)
(princ stp) )
It only does lines on top of other lines and is not idiot proof, but you can select what you want to do.
as an equal problem of cleaning up other peoples work I wrote this to clean up all those exploded hatch 0-Length lines that often arrive on my desk. :pissed: I'm not sure what overkill does with them.
(DEFUN C:SLN (/ A B C CN X Y Z DEL)
(SETQ A (SSGET (LIST(CONS 0 "LINE")))
C (SSLENGTH A)CN 0
B (REPEAT C (SETQ X (SSNAME A CN)
CN (1+ CN)
B (IF B (APPEND B (LIST X))(LIST X))
)
) ;REPEAT
) ;SETQ
(FOREACH Q B
(SETQ X (ENTGET Q)
Y (CDR (ASSOC 10 X))
Z (CDR (ASSOC 11 X))
DEL (IF (EQUAL 0 (DISTANCE Y Z) 0.0001) (ENTDEL Q))
)
)
)