Code Red > AutoLISP (Vanilla / Visual)

Overkill by selection (crossing or window)

<< < (2/3) > >>

CAB:
Find and change this line

--- Code: ---        old   (ssget "_X")
--- End code ---

to this

--- Code: ---        old   (progn (prompt "\nSelect objects or enter ALL.")(ssget))
--- End code ---

CAB:
By the way I just discovered the source of the code:

--- Quote ---;Tip1744:  CLEAR.LSP        Clear duplicates      (c)2001, Andrzej Gumula
--- End quote ---

TJAM51:
I replaced the line of code as you indicated and I received the following error....



malformed list on input

Thanks

RbtDanforth:
Before there was overkill I wrote this
--- Code: ---(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) )
--- End code ---

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.


--- Code: ---(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))
                      )
         )
)


--- End code ---

TJAM51:
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.

Navigation

[0] Message Index

[#] Next page

[*] Previous page