泉(Ango) 发表于 2013-1-9 12:10:41

诚求帮忙编一个程序！

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

gmstcn 发表于 2013-1-9 17:45:45

用多线不行么？ML

泉(Ango) 发表于 2013-1-10 12:24:12

gmstcn 发表于 2013-1-9 17:45 static/image/common/back.gif
用多线不行么？ML

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

泉(Ango) 发表于 2013-1-10 12:25:49

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

llsheng_73 发表于 2013-10-23 15:49:07

那就只能根据宽度和点取那两个点把要绘制的矩形四个角点分别计算出来

本帖最后由 llsheng_73 于 2013-10-23 15:58 编辑

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

xinght99 发表于 2013-10-27 16:00:41

解决就好
页: [1]
查看完整版本: 诚求帮忙编一个程序！