诚求帮忙编一个程序！

泉(Ango)

各位，
        大家好。在下有礼啦。我现要画很多不同宽度和长度的矩形条，所以我想就是输入一个快捷键（如：FX），然后CAD提示我输入矩形条的宽度，在输入宽度后，我任意点选平面上的两点，就能画出一条矩形条，该矩形条的宽度等于我输入的宽度值，长度等于我点选的两点间的距离，但这个矩形条的宽的中心必须分别在我点选的两点上（也就是说，该矩形的宽度关于我点选的两点所成的直线对称）。
        这与平常画的条形不一样。第一，平常画的矩形所点选的两点为矩形的对角点，而我现要的是我点选平面上的两点为宽度（参数）的中心点；第二，平常画的矩形是一个水平放置的矩形，而我现要的是矩形条不一定是水平放置，而是矩形条非宽度的边可能是水平，也可能是垂直，也可能是斜的，该边的斜率等于我点选平面上的两点所成直线的斜率。
        请问用VBA或是LISP程序怎样编这样的程序。恳请赐教。

gmstcn

用多线不行么？ML

泉(Ango)

gmstcn 发表于 2013-1-9 17:45
用多线不行么？ML

谢谢你的提醒，但多线不好编辑。

泉(Ango)

这个问题已在
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid570248
帖子解决发，再次感谢给予帮忙的各位.

llsheng_73

1. (defun C:fx(/ continu b p1 p2 q1 q2 q3 q4 dis ang)
   
2.   (setq continu t)
   
3.   (while(null(setq b(getreal"\n输入矩形宽度:"))))
   
4.   (while continu
   
5.     (setq p1(getpoint"\n点取矩形第一点(放弃退出)"))
   
6.     (if p1(progn(setq p2(getpoint p1"\n点取矩形第二点(放弃退出)"))
   
7.             (if p2(progn
   
8.                     (setq dis(distance p1 p2)
   
9.                           ang(angle p1 p2)
   
10.                           q1(polar p1(+ ang(/ pi 2))(/ b 2.0))
    
11.                           q2(polar q1 ang dis)
    
12.                           q3(polar q2(- ang(/ pi 2))b)
    
13.                           q4(polar q3(+ pi ang)dis)
    
14.                           )
    
15.                     (entmake(list(cons 0 "LWPOLYLINE")(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline")(cons 90 4)(cons 70 129)
    
16.                                  (append (list 10) q1)(append (list 10) q2)(append (list 10) q3)(append (list 10) q4)))
    
17.                     )
    
18.               (setq continu nil)))
    
19.       (setq continu nil))
    
20.     )
    
21.   (princ)
    
22.   )

(defun C:fx(/ continu b p1 p2 q1 q2 q3 q4 dis ang)<br />   (setq continu t)<br />   (while(null(setq b(getreal"\n输入矩形宽度:"))))<br />   (while continu<br />     (setq p1(getpoint"\n点取矩形第一点(放弃退出)"))<br />     (if p1(progn(setq p2(getpoint p1"\n点取矩形第二点(放弃退出)"))<br />             (if p2(progn<br />                     (setq dis(distance p1 p2)<br />                           ang(angle p1 p2)<br />                           q1(polar p1(+ ang(/ pi 2))(/ b 2.0))<br />                           q2(polar q1 ang dis)<br />                           q3(polar q2(- ang(/ pi 2))b)<br />                           q4(polar q3(+ pi ang)dis)<br />                           )<br />                     (entmake(list(cons 0 "LWPOLYLINE")(cons 100 "AcDbEntity")(cons 100 "AcDbPolyline")(cons 90 4)(cons 70 129)<br />                                  (append (list 10) q1)(append (list 10) q2)(append (list 10) q3)(append (list 10) q4)))<br />                     )<br />               (setq continu nil)))<br />       (setq continu nil))<br />     )<br />   (princ)<br />   )

xinght99

解决就好