【求助】请大侠门来编一个这样的程序！

yoyoho

同感

daidong013

回复 zhynt 的帖子

非常不错，集成了所有的功能，支持！~~

yzr2002626

顶ZHYNT，程序好用。我把那图层和那画交叉的删除了，就可以用于画窗立面

zhynt

回复 yzr2002626 的帖子

提到画窗立面，这正是我下面想做得事，我想是用对话框，带预览的，参数输入后可以直观的看到，目前正在考虑，可能需要不少的时间，敬请期待。

yzr2002626

ZHYNT,能编个这样的框选个矩形，在用虚线画出那交叉线，用户按快捷键A切换那4种方向的交叉线

yzr2002626

那切换的那顺序左右，下上循环.

zhynt

这个就太简单了，可以根据选取点的位置判断方向。

yzr2002626

编个试下撒，线谢谢了

zhynt

先粗略的写了一下，无须用户输入什么，点哪里就画哪里，没有规划图层、线型等

2. 
   
3. ;;;点到直线的距离
   
4. (defun point_line (pt pt1 pt2 / ptangle ptn pt pt1 pt2 dist jptx)
   
5.   (setq        ptangle        (angle pt1 pt2)
   
6.         ptn        (polar pt (+ (* 0.5 pi) ptangle) 0.01)
   
7.         jptx        (inters pt ptn pt1 pt2 nil)
   
8.         dist        (distance pt jptx)
   
9.   )
   
10.   dist
    
11. )
    
12. ;;;两点的中点
    
13. (defun mpt (mpt1 mpt2)
    
14.   (polar mpt1 (angle mpt1 mpt2) (/ (distance mpt1 mpt2) 2))
    
15. )
    
16. (defun C:ttt ()
    
17. ;;;获取图元以及控制点
    
18.   (setq        en  (entsel)
    
19.         ent (entget (car en))
    
20.         pt  (cadr en)
    
21.   )
    
22. ;;;获取矩形顶点表
    
23.   (setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) ent))
    
24.   (setq ptlist (mapcar 'cdr ptlist))
    
25. ;;;对顶点表排序
    
26.   (setq        ptlist
    
27.          (vl-sort ptlist
    
28.                   (function
    
29.                     (lambda (e1 e2)
    
30.                       (< (+ (car e1) (cadr e1)) (+ (car e2) (cadr e2)))
    
31.                     )
    
32.                   )
    
33.          )
    
34.   )
    
35. ;;;;规范pt1 pt2 pt3 pt4
    
36.   (setq        pt1  (nth 0 ptlist)
    
37.         pt3  (nth 3 ptlist)
    
38.         ptax (car pt1)
    
39.         ptay (cadr pt1)
    
40.         ptbx (car pt3)
    
41.         ptby (cadr pt3)
    
42.         pt2  (list ptbx ptay)
    
43.         pt4  (list ptax ptby)
    
44.   )
    
45. ;;;;矩形四边组表
    
46.   (setq        linelst        (list (list pt1 pt2)
    
47.                       (list pt1 pt4)
    
48.                       (list pt2 pt3)
    
49.                       (list pt3 pt4)
    
50.                 )
    
51.   )
    
52. ;;;获取距控制点最近的边
    
53.   (setq        linelst
    
54.          (vl-sort linelst
    
55.                   (function
    
56.                     (lambda (e1 e2)
    
57.                       (< (point_line pt (car e1) (cadr e1))
    
58.                          (point_line pt (car e2) (cadr e2))
    
59.                       )
    
60.                     )
    
61.                   )
    
62.          )
    
63.   )
    
64. 
    
65. ;;;计算中点
    
66.   (setq pt5 (mpt (car (car linelst)) (cadr (car linelst))))
    
67. ;;;获取距中点距离最大的点
    
68.   (setq        ptlist (vl-sort        ptlist
    
69.                         (function
    
70.                           (lambda (e1 e2)
    
71.                             (> (distance pt5 e1) (distance pt5 e2))
    
72.                           )
    
73.                         )
    
74.                )
    
75.   )
    
76. ;;;作图,在这里可以对图层线型进行控制
    
77.   (command "_.line" (car ptlist) pt5 (cadr ptlist) "")
    
78. )
    

<br /> ;;;点到直线的距离<br /> (defun point_line (pt pt1 pt2 / ptangle ptn pt pt1 pt2 dist jptx)<br />   (setq        ptangle        (angle pt1 pt2)<br />         ptn        (polar pt (+ (* 0.5 pi) ptangle) 0.01)<br />         jptx        (inters pt ptn pt1 pt2 nil)<br />         dist        (distance pt jptx)<br />   )<br />   dist<br /> )<br /> ;;;两点的中点<br /> (defun mpt (mpt1 mpt2)<br />   (polar mpt1 (angle mpt1 mpt2) (/ (distance mpt1 mpt2) 2))<br /> )<br /> (defun C:ttt ()<br /> ;;;获取图元以及控制点<br />   (setq        en  (entsel)<br />         ent (entget (car en))<br />         pt  (cadr en)<br />   )<br /> ;;;获取矩形顶点表<br />   (setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) ent))<br />   (setq ptlist (mapcar 'cdr ptlist))<br /> ;;;对顶点表排序<br />   (setq        ptlist<br />          (vl-sort ptlist<br />                   (function<br />                     (lambda (e1 e2)<br />                       (< (+ (car e1) (cadr e1)) (+ (car e2) (cadr e2)))<br />                     )<br />                   )<br />          )<br />   )<br /> ;;;;规范pt1 pt2 pt3 pt4 <br />   (setq        pt1  (nth 0 ptlist)<br />         pt3  (nth 3 ptlist)<br />         ptax (car pt1)<br />         ptay (cadr pt1)<br />         ptbx (car pt3)<br />         ptby (cadr pt3)<br />         pt2  (list ptbx ptay)<br />         pt4  (list ptax ptby)<br />   )<br /> ;;;;矩形四边组表<br />   (setq        linelst        (list (list pt1 pt2)<br />                       (list pt1 pt4)<br />                       (list pt2 pt3)<br />                       (list pt3 pt4)<br />                 )<br />   )<br /> ;;;获取距控制点最近的边<br />   (setq        linelst<br />          (vl-sort linelst<br />                   (function<br />                     (lambda (e1 e2)<br />                       (< (point_line pt (car e1) (cadr e1))<br />                          (point_line pt (car e2) (cadr e2))<br />                       )<br />                     )<br />                   )<br />          )<br />   )<br /> <br /> ;;;计算中点<br />   (setq pt5 (mpt (car (car linelst)) (cadr (car linelst))))<br /> ;;;获取距中点距离最大的点<br />   (setq        ptlist (vl-sort        ptlist<br />                         (function<br />                           (lambda (e1 e2)<br />                             (> (distance pt5 e1) (distance pt5 e2))<br />                           )<br />                         )<br />                )<br />   )<br /> ;;;作图,在这里可以对图层线型进行控制<br />   (command "_.line" (car ptlist) pt5 (cadr ptlist) "")<br /> )<br />

yzr2002626

先前那我表达错了，意思是那矩形是拉框画的，不是选择矩形