Category : Printer + Display Graphics
Archive   : 1988LISP.ZIP
Filename : ROSS.LSP

;
;
(defun c:ctan ()
(setq p1 (getpoint "\npoint to first circle: "))
(setq p2 (getpoint "\npoint to second circle: "))
(setq p1 (osnap p1 "near"))
(setq p2 (osnap p2 "near"))
(setq c1 (osnap p1 "cen"))
(setq p4 (osnap p2 "cen"))
(setq p5 (distance c1 p4))
(setq a1 (angle c1 p4))
(setq p1a (distance p1 c1))
(setq a2 (distance p2 p4))
(setq p3 (polar c1 a1 (* (/ p1a a2) (/ p5 (1+ (/ p1a a2))))))
(command "line" p3 "tan" p1 "")
(command "line" p3 "tan" p2 "")
)
;
;
(defun c:PAR1 ()
(setvar "CMDECHO" 0)
(setq p4 (getpoint "\npoint to line: "))
(setq p4 (osnap p4 "near"))
(setq x (osnap p4 "end"))
(setq y (osnap x "mid"))
(setq z (distance x y))
(setq a (angle x y))
(setq perpa1 a)
(setq perpa1 (angtos perpa1 0 5))
(setq perpSM (getvar "SNAPMODE"))
(setq perpSM (1+ perpSM))
(command "snap" "r" "0,0" (read perpa1))
(setq perpOM (getvar "ORTHOMODE"))
(setq perpOM (1+ perpOM))
(if (= perpOM 1) (setvar "ORTHOMODE" 1))
(setq p3 (getdist p4 "\nenter offset from center: "))
(command "snap" "r" "0,0" "0")
(if (= perpOM 1) (setvar "ORTHOMODE" 0))
(if (= perpSM 1) (setvar "SNAPMODE" 0))
(setq p1 (polar x (+ (/ pi 2) a) p3))
(setq p2 (polar p1 a (* z 2)))
(command "line" p1 p2 "")
(setq p1 (polar p1 (+ (/ (* 3 pi) 2) a) (* 2 p3)))
(setq p2 (polar p1 a (* z 2)))
(command "line" p1 p2 "")
)
;
;
(defun c:PERP ()
(setvar "CMDECHO" 0)
(setq perp1 (getpoint "\nperp from: "))
(setq perpN (osnap perp1 "near"))
(setq perp2 (osnap perpN "end"))
(setq perpa1 (angle perpN perp2))
(setq perpa1 (angtos perpa1 0 5))
(setq perpSM (getvar "SNAPMODE"))
(setq perpSM (1+ perpSM))
(command "snap" "r" "0,0" (read perpa1))
(setq perpOM (getvar "ORTHOMODE"))
(setq perpOM (1+ perpOM))
(if (= perpOM 1) (setvar "ORTHOMODE" 1))
(command "line")
(command perpN)
(while (setq perp3 (getpoint))
(command perp3)
)
(command "")
(command "snap" "r" "0,0" "0")
(if (= perpOM 1) (setvar "ORTHOMODE" 0))
(if (= perpSM 1) (setvar "SNAPMODE" 0))
)
;
;
(defun c:ROT ()
(setvar "CMDECHO" 0)
(if (null nz) (command "block" 1 "0,0" ""))
(command "block" 1 "yes")
(command (setq c (getpoint "rotation center point: ")))
(while (setq p1 (getpoint "select objects "))
(command p1))
(command "")
(setq a (getangle c "enter rotation angle: "))
(setq a (angtos a 0 5))
(command "insert" "*1" c 1 a)
(setq nz 1)
)
;
;
(defun c:stan ()
(setq p1 (getpoint "\npoint to first circle: "))
(setq p2 (getpoint "\npoint to second circle: "))
(setq p1 (osnap p1 "near"))
(setq p2 (osnap p2 "near"))
(setq c1 (osnap p1 "cen"))
(setq c2 (osnap p2 "cen"))
(setq d1 (distance c1 c2))
(setq a1 (angle c1 c2))
(setq r1 (distance p1 c1))
(setq r2 (distance p2 c2))
(if (= (read(rtos r1 2 8)) (read(rtos r2 2 8)))
(progn
(setq a2 (angle c1 p1))
(if (< a2 0.0) (setq a2 (+ a2 (* 2 pi))))
(if (and (> (- a2 a1) 0.0) (< (- a2 a1) pi))
(setq a2 (+ a1 (/ pi 2))))
(if (and (> (- a2 a1) pi) (< (- a2 a1) (* 2 pi)))
(setq a2 (+ a1 (/ (* 3 pi) 2))))
(setq p4 (polar c1 a2 r1))
(command "line" p4 "tan" p2 "")
)
(progn
(setq p3 (polar c1 a1
(* (/ d1 (1- (/ r1 r2))) (/ r1 r2))))
(command "line" p3 "tan" p2 "tan" p1 "")
(command "erase" p3 "")
))
)
;
;