;|
TTX1.LSP (8 Agosto 2005)
Copyright (C) 2005 Claudio Piccini
All rights reserved
www.cg-cad.com
| | | |
-*-|-|--- : ---| |---
---|-|--- ---| |---
| | | |
| | | |
---|-|--- : ---| |---
-*-|-|--- ---| |---
| | | |
| | | |
---|-|-*- : ---| |---
---|-|--- ---| |---
| | | |
* | | |
---|-|--- : ---------
---|-|--- ---------
| | | |
| * | |
---|-|--- : ---------
---|-|--- ---------
| | | |
| | | |
---|-|--- ; ---------
---|-|--- ---------
| * | |
|;
(defun myerror (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(ripVar)
(princ)
)
(defun salVar ()
(setq orto (getvar "orthomode"))
(setq snapp (getvar "osmode"))
(setq snm (getvar "snapmode"))
(setq piano (getvar "clayer"))
(setq raggio (getvar "filletrad"))
)
(defun ripVar ()
(command "_redraw")
(setvar "cmdecho" 1)
(setvar "osmode" snapp)
(setvar "snapmode" snm)
(setvar "orthomode" orto)
(setvar "clayer" piano)
(setvar "filletrad" raggio)
(setvar "cecolor" "BYLAYER")
(setq *error* olderr)
(princ)
)
(defun TsuT1 ( / test ent ll1 ll2 l1 l2
x y xx yy
a b c d e f g h
i1 i2 i3 i4
m1 m2 m3 m4
)
(setq test T)
(setq ent (car s2))
(setq ent (entget ent))
(if (= "LINE" (cdr (assoc 0 ent)))
(progn
(setq ll1 (assoc 10 ent))
(setq ll2 (assoc 11 ent))
(setq x (cdr ll1))
(setq y (cdr ll2))
)
(progn
(princ "\n non e' stata selezionata una linea!")
(setq test nil)
)
)
(while test
(setq ent (entget (ssname s1 0)))
(if (= "LINE" (cdr (assoc 0 ent)))
(progn
(setq l1 (assoc 10 ent))
(setq l2 (assoc 11 ent))
(setq a (cdr l1))
(setq b (cdr l2))
(if
(or
(and
(= (car x)(car a))(= (cadr x)(cadr a))
(= (car y)(car b))(= (cadr y)(cadr b))
)
(and
(= (car x)(car b))(= (cadr x)(cadr b))
(= (car y)(car a))(= (cadr y)(cadr a))
)
)
(progn
(setq xx a)(setq yy b)
)
)
)
(setq test nil)
)
(setq ent (entget (ssname s1 1)))
(if (= "LINE" (cdr (assoc 0 ent)))
(progn
(setq l1 (assoc 10 ent))
(setq l2 (assoc 11 ent))
(setq c (cdr l1))
(setq d (cdr l2))
(if
(or
(and
(= (car x)(car c))(= (cadr x)(cadr c))
(= (car y)(car d))(= (cadr y)(cadr d))
)
(and
(= (car x)(car d))(= (cadr x)(cadr d))
(= (car y)(car c))(= (cadr y)(cadr c))
)
)
(progn
(setq xx c)(setq yy d)
)
)
)
(setq test nil)
)
(setq ent (entget (ssname s1 2)))
(if (= "LINE" (cdr (assoc 0 ent)))
(progn
(setq l1 (assoc 10 ent))
(setq l2 (assoc 11 ent))
(setq e (cdr l1))
(setq f (cdr l2))
(if
(or
(and
(= (car x)(car e))(= (cadr x)(cadr e))
(= (car y)(car f))(= (cadr y)(cadr f))
)
(and
(= (car x)(car f))(= (cadr x)(cadr f))
(= (car y)(car e))(= (cadr y)(cadr e))
)
)
(progn
(setq xx e)(setq yy f)
)
)
)
(setq test nil)
)
(setq ent (entget (ssname s1 3)))
(if (= "LINE" (cdr (assoc 0 ent)))
(progn
(setq l1 (assoc 10 ent))
(setq l2 (assoc 11 ent))
(setq g (cdr l1))
(setq h (cdr l2))
(if
(or
(and
(= (car x)(car g))(= (cadr x)(cadr g))
(= (car y)(car h))(= (cadr y)(cadr h))
)
(and
(= (car x)(car h))(= (cadr x)(cadr h))
(= (car y)(car g))(= (cadr y)(cadr g))
)
)
(progn
(setq xx g)(setq yy h)
)
)
)
(setq test nil)
)
;|
se sono tutte linee
esegue la procedura
|;
(if (/= test nil)
(progn
(setq i1 (inters a b c d))
(if (/= i1 nil)
(progn
(setq i2 (inters e f g h))
(setq i3 (inters a b e f))
(if (/= i3 nil)
(progn
(setq i4 (inters c d g h))
(command "osnap" "_mid")
(setq m1 (polar i1 (angle i1 i3) (/ (distance i1 i3) 2)))
(setq m2 (polar i2 (angle i2 i3) (/ (distance i2 i3) 2)))
(setq m3 (polar i2 (angle i2 i4) (/ (distance i2 i4) 2)))
(setq m4 (polar i1 (angle i1 i4) (/ (distance i1 i4) 2)))
(command "osnap" "_non")
(if
(or
(or (and (= xx a)(= yy b)) (and (= xx b)(= yy a)))
(or (and (= xx g)(= yy h)) (and (= xx h)(= yy g)))
)
(progn
(command "_break" m1 "_f" i1 i3)
(command "_break" m3 "_f" i2 i4)
)
(progn
(command "_break" m2 "_f" i2 i3)
(command "_break" m4 "_f" i1 i4)
)
)
)
(progn
(setq i3 (inters a b g h))
(setq i4 (inters c d e f))
(command "osnap" "_mid")
(setq m1 (polar i1 (angle i1 i3) (/ (distance i1 i3) 2)))
(setq m2 (polar i2 (angle i2 i3) (/ (distance i2 i3) 2)))
(setq m3 (polar i2 (angle i2 i4) (/ (distance i2 i4) 2)))
(setq m4 (polar i1 (angle i1 i4) (/ (distance i1 i4) 2)))
(command "osnap" "_non")
(if
(or
(or (and (= xx a)(= yy b)) (and (= xx b)(= yy a)))
(or (and (= xx e)(= yy f)) (and (= xx f)(= yy e)))
)
(progn
(command "_break" m1 "_f" i1 i3)
(command "_break" m3 "_f" i2 i4)
)
(progn
(command "_break" m2 "_f" i2 i3)
(command "_break" m4 "_f" i1 i4)
)
)
)
)
)
(progn
(setq i1 (inters a b e f))
(setq i2 (inters a b g h))
(setq i3 (inters c d e f))
(setq i4 (inters c d g h))
(command "osnap" "_mid")
(setq m1 (polar i1 (angle i1 i2) (/ (distance i1 i2) 2)))
(setq m2 (polar i2 (angle i2 i4) (/ (distance i2 i4) 2)))
(setq m3 (polar i3 (angle i3 i4) (/ (distance i3 i4) 2)))
(setq m4 (polar i1 (angle i1 i3) (/ (distance i1 i3) 2)))
(command "osnap" "_non")
(if
(or
(or (and (= xx a)(= yy b)) (and (= xx b)(= yy a)))
(or (and (= xx c)(= yy d)) (and (= xx d)(= yy c)))
)
(progn
(command "_break" m1 "_f" i1 i2)
(command "_break" m3 "_f" i3 i4)
)
(progn
(command "_break" m2 "_f" i2 i4)
(command "_break" m4 "_f" i1 i3)
)
)
)
)
)
(princ "\nSelezionare solo le linee!")
)
(setq test nil)
)
)
(defun C:TTX1 ( / olderr
snapp snm orto piano raggio
s1 s2 p1 p2
)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(command "_fillet" "_r" 0)
(command "osnap" "_non")
(command "osnap" "_near")
(setq s2 (entsel "\n Seleziona la linea da cancellare: "))
(command "osnap" "_non")
(setq p1 (getpoint "\n Seleziona l'incrocio con una finestra: "))
(initget (+ 1 32))
(setq p2 (getcorner p1 "\n Secondo punto della finestra: "))
(setq s1 (ssget "_C" p1 p2))
(if (and (/= s1 nil)(/= s2 nil))
(TsuT1)
(alert "Non e' stata selezionata nessuna entita'")
)
(ripVar)
)
;;;eof
| 
