;判断直线所处象限 ZZXXQQ 2008.11.21
(defun c:tt ()
(if (setq p0 (getpoint "\n坐标原点 :")) (progn
(setq x0 (car p0) y0 (cadr p0))
(if (and (setq s1 (entsel "\n选择一条直线 :"))
(setq ent (entget (car s1)))
(= (cdr(assoc 0 ent)) "LINE")) (progn
(setq p1 (cdr(assoc 10 ent))
p2 (cdr(assoc 11 ent))
x1 (car p1)y1 (cadr p1)
x2 (car p2)y2 (cadr p2))
(cond
((and (<= x0 x1) (<= x0 x2) (<= y0 y1) (<= y0 y2)) (princ "1象限"))
((and (>= x0 x1) (>= x0 x2) (<= y0 y1) (<= y0 y2)) (princ "2象限"))
((and (>= x0 x1) (>= x0 x2) (>= y0 y1) (>= y0 y2)) (princ "3象限"))
((and (<= x0 x1) (<= x0 x2) (>= y0 y1) (>= y0 y2)) (princ "4象限"))
(T (princ "error!"))
)
))
))
(princ)
)
(defun c:ttt (/ A B ENT P0 P1 P2 PI/2 S1)
(if (and (setq p0 (getpoint "\n坐标原点 :"))
(setq s1 (entsel "\n选择一条直线 :"))
(setq ent (entget (car s1)))
(= (cdr (assoc 0 ent)) "LINE")
)
(progn
(setq p1(cdr (assoc 10 ent))
p2(cdr (assoc 11 ent))
pi/2 (/ pi 2)
)
(setq a (1+ (fix (/ (angle p0 p1) pi/2)))
b (1+ (fix (/ (angle p0 p2) pi/2)))
)
(if (= a b)
(princ (strcat (itoa a) "象限"))
(princ (strcat (itoa a) "~" (itoa b) "象限"))
)
)
)(princ)
) 很简单的问题楼主都不愿动手，如今的人。。。 <p>是应该批评一下。</p><p>在明经将近1年半的时间都没有多少进步，哪位老板这么难为我们的BMW。</p> 你们老板要不是很有耐心就是很喜欢你。要不他/她怎么受得了哦
页:
[1]