;;
;;
(defun rk_cp ( / p1 p2 flag lst lst2 n str
tmp_seg p_isect)
(defun tmp_seg ( p1 p2 p3 / )
(if p_tmp_seg
(progn
(if (and (car p_tmp_seg) (cadr p_tmp_seg))
(grdraw (car p_tmp_seg) (cadr p_tmp_seg) 0)
);if
(if (and (cadr p_tmp_seg) (caddr p_tmp_seg))
(grdraw (cadr p_tmp_seg) (caddr p_tmp_seg) 0)
);if
);progn
);if
(if p2
(progn
(if (and p1 p2)
(grdraw p1 p2 7 -1)
);if
(if (and p2 p3)
(grdraw p2 p3 7 -1)
);if
(setq p_tmp_seg (list p1 p2 p3))
);progn
(setq p_tmp_seg nil)
);if
);defun tmp_seg
(defun p_isect (lst flag2 / flag lst2 lst3 a b c d n j)
(setq n 0)
(repeat (length lst)
(setq a (nth n lst)
lst2 (append lst2 (list a))
);setq
(if (equal 2 (length lst2))
(setq lst3 (append lst3 (list lst2))
lst2 (list (cadr lst2))
);setq
);if
(setq n (+ n 1))
);repeat
(if (equal 2 (length lst2))
(setq lst3 (append lst3 (list lst2)))
);if
(setq lst3 (append lst3 (list (append (list (car (reverse lst))) (list (car lst))))))
(setq n 0)
(while (and (< n (length lst3))
(not flag)
);and
(setq a (nth n lst3)
b (cadr a)
a (car a)
);setq
(setq j (+ n 1))
(while (and (< j (length lst3))
(not flag)
);and
(setq c (nth j lst3)
d (cadr c)
c (car c)
);setq
(if (and (not (equal b c 0.000001))
(not (equal a d 0.000001))
);and
(progn
(setq flag (inters a b c d))
(if (and flag flag2)
(progn
(princ "\n无效点. 交叉多边形各边不能相交.")
(princ flag2)
);progn
);if
);progn
);if
(setq j (+ j 1))
);while
(setq n (+ n 1))
);while
flag
);defun p_isect
(setq p1 (if p p (getpoint "\n交叉多边形第一点: "))
lst2 (list p1)
str ""
);setq
(princ "\nUndo/<下一点>: ")
(while (not flag)
(setq p2 (grread t 4 0))
;(setq p2 (getpoint p1))
;(grdraw p1 p2 2 1)
(cond
((equal 5 (car p2)) (tmp_seg p1 (cadr p2) (if (> (length lst2) 1) (car lst2) nil)));cond 1
((and (equal 3 (car p2)) (not (p_isect (append lst2 (list (cadr p2))) "\nUndo/<下一点>: ")));and
(progn (princ "\nUndo/<下一点>: ")
(setq lst (append lst (list (list (car p_tmp_seg) (cadr p_tmp_seg))))
lst2 (append lst2 (list (cadr p_tmp_seg))) str ""
p1 (cadr p_tmp_seg) p_tmp_seg (list nil p1 (caddr p_tmp_seg))
) );progn
);cond 2
((or (equal p2 '(2 13)) ;return
(equal p2 '(2 32)) ;space
(equal p2 '(11 0)) ;right click
);or
(progn
(princ "\nUndo/<下一点>: ")
(if (equal str "")
(progn
(setq flag T)
(setq n 0)
(tmp_seg nil nil nil)
(repeat (length lst)
(setq p_tmp_seg (nth n lst))
(tmp_seg nil nil nil)
(setq n (+ n 1));setq
);repeat
);progn
(progn
(if (and (equal str "U")
(> (length lst) 0)
);and
(progn
(tmp_seg nil nil nil)
(setq p_tmp_seg (last lst))
(tmp_seg nil nil nil)
(setq lst (reverse (cdr (reverse lst)))
lst2 (reverse (cdr (reverse lst2)))
p1 (last lst2)
);setq
);progn
(progn
(if (equal str "U")
(princ "\n取消所有定义线.\n")
(princ "\n无效.\n")
);if
(princ "\nUndo/<下一点>: ")
);progn
);if
);progn
);if
(setq str "")
);progn
);cond 3
( (equal 2 (car p2))
(progn
(if (equal p2 '(2 8))
(progn
(if (> (strlen str) 0)
(progn
(princ (chr (cadr p2)))
(princ " ")
(princ (chr (cadr p2)))
(setq str
(substr str 1 (max 0 (- (strlen str) 1)))
);setq
);progn
);if
);progn
(progn
(princ (chr (cadr p2)))
(setq str (strcat str (strcase (chr (cadr p2)))))
);progn
);if
);progn
);cond 4
);cond
);while
(if (or (<= (length lst2) 2)
(p_isect (append lst2 (list (car lst2))) "")
);or
(progn
(setq lst2 nil);setq
(princ "\n交叉多边形未定义.")
);progn
);if
lst2
);defun rk_cp
;判断点P0位于范围线Plist的内部或外部
;Plist的左下角_downleft 右上角_upRight
(defun isInorOut (P0 Plist _downleft _upRight /
distL distR distMax p p1 oldp jpL i ret
)
(setq oldp (last Plist)
distL (distance p0 (list (car _downleft) (cadr p0)))
distR (distance p0 (list (car _upRight) (cadr p0)))
distMax (distance _upRight _downleft)
distMax (max distL distR distMax)
p1 (polar p0 0.0 distMax)
ret nil jpL 0 i -1
)
(while (and (not ret) (setq p (nth (setq i (1+ i)) Plist)))
(if (< (* (- (cadr p0) (cadr p)) (- (cadr p0) (cadr oldp))) 0);(progn
(if (setq p2 (inters p0 p1 oldp p))(progn
(setq jpL (1+ jpL))
(if (equal 0 (- (car p0) (car p2))) (setq ret t))
))
);)
(setq oldp p)
)
(cond
(ret 0) ;线上
((= (rem jpL 2) 1) 1) ;内
(t -1) ;外
)
)
;;;(defun isInorOut (P0 Plist _downleft _upRight / p00 p p1 p2 p3 oldp jpL jpR i k l ret)
;;; (setq oldp (last Plist)
;;; p (distance p0 (list (car _downleft) (cadr p0)))
;;; p1 (distance p0 (list (car _upRight) (cadr p0)))
;;; p2 (distance _upRight _downleft)
;;; p (max p p1 p2)
;;; p00 (polar p0 pi p)
;;; p1 (polar p00 0 (+ p p))
;;; ret nil jpL 0 jpR 0 i -1
;;; )
;;; (while (and (not ret) (setq p (nth (setq i (1+ i)) Plist)))
;;; (if (< (* (- (cadr p0) (cadr p)) (- (cadr p0) (cadr oldp))) 0)(progn
;;; (if (setq p2 (inters p00 p1 oldp p))(progn
;;; (setq k (- (car p0) (car p2)))
;;; (cond
;;; ((< 0 k) (setq jpL (1+ jpL)))
;;; ((= 0 k) (setq ret 0)) ;线上
;;; ((> 0 k) (setq jpR (1+ jpR)))
;;; )
;;; ))
;;; ))
;;; (setq oldp p)
;;; )
;;; (if (not ret)(progn
;;; (if (and (= (rem jpL 2) 1) (= (rem jpR 2) 1))
;;; (setq ret 1) ;内
;;; (setq ret -1) ;外
;;; )
;;; ))
;;; ret
;;;)
(defun getDownLeftandUpRight (_plist / _p _DownLeft _UpRight)
(setq _DownLeft (car _plist) _UpRight (car _plist))
(foreach _p (cdr _plist)
(setq _DownLeft (mapcar 'min _DownLeft _p) _UpRight (mapcar 'max _UpRight _p))
)
(list _DownLeft _UpRight)
)
posted on 2008-03-11 13:25
深藏记忆 阅读(101)
评论(0) 编辑 收藏 所属分类:
Vlisp之韵