TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: TJAM51 on April 13, 2006, 09:27:57 AM
-
I am using 2006. Is there a routine similar to overkill but will work through a window of crossing selection only.....thanks
-
You could modify this one.
http://www.theswamp.org/index.php?topic=8609.msg109928#msg109928
-
When I run this routine it does not prompt me to select anything or any areas. It runs on its own without any prompts.
-
Yes, that's why I said "You could modify this one".
Is that something you can do?
-
I apologize Cab...did not read that portion of your reply... :| I do not have the experience to develope this routine that far.....I do appreciate your assistance
-
Find and change this line
old (ssget "_X")
to this
old (progn (prompt "\nSelect objects or enter ALL.")(ssget))
-
By the way I just discovered the source of the code:
;Tip1744: CLEAR.LSP Clear duplicates (c)2001, Andrzej Gumula
-
I replaced the line of code as you indicated and I received the following error....
malformed list on input
Thanks
-
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))
)
)
)
-
Thanks for all your assistance, but it appears that there are still lines or whatever still left. For example I placed 5 lines on top of one another and when I ran the routine it deleted one leaving 4 behind.
-
tj,
Did you get the Clear.lsp to work?
Ans did it remove the excess lines?
-
The clear lisp would not work by crossing or window selection...it would run through the entire drawing.....