您的位置:网站首页 > CAD新闻

AutoLISP实现橡皮筋绘图预览

时间:2012-02-01 08:31:26 来源:未知

AutoLISP里getpoint命令如果指定第二个参数的话,自动实现橡皮筋效果,但是同时绘制三条直线的时候无法实现橡皮筋效果,虽然grread函数能够实现鼠标移动时候的预览,但是grread函数执行的时候是不能执行对象捕捉的,因此无法指定绘图的第二点。

(defun c:tt ()
    (setq r (getreal "n请输入管道宽度:"))
    (if    (= nil r)
    (setq r 100)
    )
;;;    (If    (= p1 nil)
    (setq p1 (getpoint "n起点:"))
;;;    )
    (setq flag t)
    (while (and flag (setq get (grread 1 7 0)))
    (cond
;;;        点击鼠标左键画图
        ((= 3 (car get))
         (setq p2 (cadr (grread 1)))
         (setq ang (angle p1 p2))
         (setq p1down (polar p1 (+ ang (* 1.5 pi)) (/ r 2)))
         (setq p2down (polar P2 (+ ang (* 1.5 pi)) (/ r 2)))
         (setq p1up (polar p1 (+ ang (/ pi 2)) (/ r 2)))
         (setq p2up (polar p2 (+ ang (/ pi 2)) (/ r 2)))
         (command "line" p1 p2 "")
         (command "line" p1up p2up "")
         (command "line" p1down p2down "")
         (redraw)
         (exit)
        )
;;;        鼠标右键退出
        ((= 25 (car get))
         (setq flag nil)
        )
;;;        鼠标拖动显示预览
        ((= 5 (car get))
        
         (setq temppt (list    (car (cadr (grread 1)))
                (cadr (cadr (grread 1)))
              )
         )
         (setq tempang (angle p1 temppt))
         (setq tempp1down (polar p1 (+ tempang (* 1.5 pi)) (/ r 2)))
         (setq
         tempp2down
            (polar temppt
               (+ tempang (* 1.5 pi))
               (/ r 2)
            )
         )
         (setq tempp1up (polar p1 (+ tempang (/ pi 2)) (/ r 2)))
         (setq tempp2up (polar temppt (+ tempang (/ pi 2)) (/ r 2)))
         (redraw)
         (grdraw p1 temppt 1)
         (grdraw tempp1down tempp2down 1) #p#分页标题#e#
         (grdraw tempp1up tempp2up 1)
        )
        (t nil)
    )
    )
)

该段程序还有一个问题是鼠标移动的时候执行grread函数但是,点击鼠标左键指定绘图第二点的时候并不能保证鼠标移动循环已经结束,因此当光标没有变成十字型时候,单击左键无效,试图用鼠标反应器解决该问题,但是鼠标事件只有双击和右键单击事件,没有鼠标移动事件。这里还有网上的一个类似的问题。