home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
cad
/
may93.zip
/
TIP870.LSP
< prev
next >
Wrap
Text File
|
1993-05-12
|
4KB
|
138 lines
; TIP870.LSP [DELOUT.LSP]
; Delete Outside of Windoe (c)1993, Wolf Praetorius
(defun C:DELOUT ( / cmde pt1 pt2 A1 A2 pt3 pt4 ss1 ss2 ss3)
(setq m:err *error* *error* *merr*
cmde (getvar "CMDECHO")
)
(setvar "CMDECHO" 0)
(setq pt1 (getpoint "\nFirst corner of area to be retained : ")
pt2 (getcorner pt1 "\nOther corner: ")
)
(command "_.PLINE" pt1 (list (car pt1) (cadr pt2))
pt2 (list (car pt2) (cadr pt1))
"_C"
)
(setq A1 (angle pt2 pt1))
(setq A2 (angle pt1 pt2))
(setq pt3 (polar pt1 A1 0.1))
(setq pt4 (polar pt2 A2 0.1))
(command "trim" pt1 "" "FENCE" pt3 (list (car pt3) (cadr pt4)) ""
"FENCE" (list (car pt3) (cadr pt4)) pt4 ""
"FENCE" pt4 (list (car pt4) (cadr pt3)) ""
"FENCE" (list (car pt4) (cadr pt3)) pt3 "" "")
(setq picked nil)
(setq cntr1 0)
(setq cntr2 0)
(setq cntr3 0)
(setq cntr4 0)
(setq cntr6 0)
(setq ss3 (ssadd))
;------Define selection set #1 (entity(s) to-be-retained)------------
(while (not picked)
(prompt "\nWindow entity(s) to-be-retained:")(prin1)
(setq ss1 (ssget "w" pt1 pt2))
(if (/= ss1 nil)
(progn
(prompt "\nWorking...")(prin1)
(setq ss1lng (sslength ss1))
(setq picked 0)
)
(progn
(prompt "\nERROR: No Entity(s) Found - Select Again...")
(prin1)
)
)
)
;------Find all layers in current drawing-----------------------------
(setq lyr (tblnext "layer" T))
(while (/= cntr3 nil)
(if (and (or (= (cdr (assoc 70 lyr)) 64)
(= (cdr (assoc 70 lyr)) 0)
)
(/= (minusp (cdr (assoc 62 lyr))) T)
)
(progn
(setq incrval (itoa cntr4))
(setq cntr4 (1+ cntr4))
(set (read (strcat "lyr" incrval))
(cons 8 (cdr (assoc 2 lyr))))
(setq lyr (tblnext "layer"))
)
(setq lyr (tblnext "layer"))
)
(cond
((= lyr nil)
(setq cntr3 nil)
)
)
)
;------Build selection set #2 & #3 (of displayed entitys)-------------
(setq cntr5 (1- cntr4))
(setq cntr4 0)
(while (<= cntr4 cntr5)
(setq incrval (itoa cntr4))
(setq ss2 (ssget "x" (list (eval (read (strcat "lyr" incrval))))))
(if (/= ss2 nil)
(progn
(while (< cntr6 (sslength ss2))
(setq enty (ssname ss2 cntr6))
(setq ss3 (ssadd enty ss3))
(setq cntr6 (1+ cntr6))
)
)
)
(setq cntr4 (1+ cntr4))
(setq cntr6 0)
)
;------Determine if entity(s) exist in both selection sets (#2 & #3)--
(setq ss2 (ssadd))
(while (< cntr2 (sslength ss3))
(setq entnm3 (ssname ss3 cntr2))
(if (not (ssmemb entnm3 ss1))
(progn
(setq ss2 (ssadd entnm3 ss2))
(setq cntr2 (1+ cntr2))
)
(setq cntr2 (1+ cntr2))
)
)
;------Delete all entity(s) outside of defined window-----------------
(if (/= (sslength ss2) 0)
(progn
(command ".erase" ss2 "")
(prompt "\n\n")
(princ (sslength ss2))(princ " entity(s) found & DELETED...")
(prin1)
)
(progn
(prompt "\nNO entity(s) found outside defined window...")(prin1)
)
)
(setvar "CMDECHO" cmde)
(setq *error* m:err m:err nil)
(princ)
(command "redraw")
) ; END