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函數但是,點擊鼠標左鍵指定繪圖第二點的時候并不能保證鼠標移動循環已經結束,因此當光標沒有變成十字型時候,單擊左鍵無效,試圖用鼠標反應器解決該問題,但是鼠標事件只有雙擊和右鍵單擊事件,沒有鼠標移動事件。這里還有網上的一個類似的問題。
相關文章
- 2021-07-30AutoCAD程序設計魔法書 [AutoLISP DCL基礎篇]PDF下載
- 2020-12-24AutoCAD 2004與AutoLISP二次開發技術PDF下載
- 2012-05-24AutoCAD 2004與AutoLISP二次開發技術
- 2010-12-29AutoLISP知識普及及相關教程
- 2010-11-18柱子填充的autolisp源代碼下載
- 2010-11-18pkpm梁配筋計算書歸并程序(含autolisp源碼下載)
- 2010-11-18黃金右手autolisp源碼下載
- 2010-11-18體積配箍率計算程序autolisp源碼下載
- 2010-11-18CAD批量打印autolisp源碼下載
- 2009-12-13二維螺紋的AutoLISP工具免費下載