[分享]投影矩形.LSP

因為工作還蠻常畫投影矩形,
所以就寫了這個小程式,
用起來還算堪用,如果有需要就請夾去配吧~

代碼:

(defun C:PREC (/ P1 P2 P3 L rec:P oldos oldla TK m)
  (defun str1 (m)
    (COND ((OR (null m) (EQ m "C")) (eval "M F"))
     ((EQ m "M") (eval "C F"))
     ((EQ m "F") (eval "C M"))
    )
  )
  (defun str2 (m)
    (COND ((OR (null m) (EQ m "C"))
      (SETQ m "近端點或[中點(M)/遠端點(F)]:")
     )
     ((EQ m "M") (SETQ m "中點或[近端點(C)/遠端點(F)]:"))
     ((EQ m "F") (SETQ m "遠端點或[近端點(C)/中點(M)]:"))
    )
    (strcat "終點,移動時使用" m)
  )
  (setvar "cmdecho" 0)
  (setq oldos (getvar "osmode"))
  (setq oldla (getvar "clayer"))
  (command "UCS" "W")
  (INITGET 1)
  (SETQ L (getdist "長度:"))
  (prin1 L)
  (INITGET 1)
  (SETQ P1 (getpoint "起點:"))
  (SETQ
    P2
     (while (OR (null TK) (EQ (TYPE TK) 'STR) (EQ P1 TK))
       (INITGET 1 (str1 m))
       (SETQ TK (getpoint P1 (str2 m)))
       (IF (EQ (TYPE TK) 'STR)
    (SETQ m TK)
       )
       (eval 'TK)
     )
  )
  (IF (null m)
    (SETQ m "C")
  )
  (prin1 (strcat "基準線長"
       (rtos (distance P1 P2) 2 8)
    )
  )
  (INITGET 1)
  (command "UCS"
      "3"
      P2
      P1
      (getpoint "選擇投影方向:")
  )
  (setq P1 (trans P1 0 1))
  (setq P2 (trans P2 0 1))
  (SETQ rec:P (polar P2 (+ (* pi 1.5) (angle P1 P2)) L))
  (COND   ((EQ m "C") (SETQ mp P2))
   ((EQ m "M")
    (SETQ mp (polar P2 (+ (* pi 1.5) (angle P1 P2)) (/ L 2)))
   )
   ((EQ m "F") (SETQ mp rec:P))
  )
  (command "RECTANG" P1 rec:P)
  (command "MOVE" (entlast) "" mp)
  (setvar "osmode" oldos)
  (setvar "clayer" oldla)
  (prin1)
) ;_last

執行後的操作手順是
1.先輸入投影後矩形的長度
2.再點要投影矩形的兩點位置

[版本V1.01]
剛剛發現到有個debug用的參數沒拿掉,雖然說沒拿掉有不會有影響到程式運行@@a

[追加一個比較簡單的版本]這個版本程式執行過程中不會計算最後MOVE的基準點

代碼:

(defun C:PREC (/ P1 P2 P3 L rec:P oldos oldla TK)
  (setvar "cmdecho" 0)
  (setq oldos (getvar "osmode"))
  (setq oldla (getvar "clayer"))
  (command "UCS" "W")
  (INITGET 1)
  (SETQ L (getdist "長度:"))
  (prin1 L)
  (INITGET 1)
  (SETQ P1 (getpoint "起點:"))
  (SETQ
    P2
    (while (OR (null TK) (EQ P1 TK))
      (INITGET 1)
      (SETQ TK (getpoint P1 "終點："))
    )
  )
  (prin1 (strcat "基準線長"
       (rtos (distance P1 P2) 2 8)
    )
  )
  (INITGET 1)
  (command "UCS"
     "3"
     P2
     P1
     (getpoint "選擇投影方向:")
  )
  (setq P1 (trans P1 0 1))
  (setq P2 (trans P2 0 1))
  (SETQ rec:P (polar P2 (+ (* pi 1.5) (angle P1 P2)) L))
  (command "RECTANG" P1 rec:P)
  (command "MOVE" (entlast) "")
  (setvar "osmode" oldos)
  (setvar "clayer" oldla)
  (prin1)
) ;_last

有這版本其實是發現自己這幾天用下來,
有記得要切換近端點/中點/遠端點的次數比忘記要用的次數還多~"~

好像直接畫矩形配合"物件追蹤"+"相對座標"還比較快~

真不知道自己甚麼時候可以進入LSP的境界啊~
我想我還卡在入門啊~"~
(讓我入~讓我入~~~)

謝謝樓主熱心分享>"<

明~ 寫到:好像直接畫矩形配合"物件追蹤"+"相對座標"還比較快~

就知道矩形投影長度的情況下的確是這樣,
但我蠻多時候是不知道的,
而這程式一開始的輸入長度是可以用點兩點的方式抓長度,
對我而言算是比較方便用的;p

safardy 寫到:真不知道自己甚麼時候可以進入LSP的境界啊~
我想我還卡在入門啊~"~
(讓我入~讓我入~~~)

謝謝樓主熱心分享>"<

我也還在入門~"~

其實我上次在別的公司碰AutoCAD的時候就有接觸AutoLISP,
大概是兩三年前,
那時想說自己以前有碰過VB,
應該可以寫出自己想要的程式,
結果在能寫出完整的程式前就換了工作,
當時想寫的程式現在自己還完全寫不出來,
太眼高手低了Orz....
能夠完整寫出程式是在這次的工作,
工作了一年多後有比較確認自己的工作內容後才再開始AutoLISP,
而且是練習好幾次基礎的練習,
看了不少簡單的程式,
並瞭解其運作後才開始寫簡單的程式.

話說這支程式是我動手寫的第三支程式,
第一支很簡單只是單純地用指令"TIME"計算關閉圖塊的時間,
第二支雖然一開始想要寫的東西很簡單,
但寫到一半想加進去的功能太多了,
目前還在難產中Orz...
這次就想別再這樣惡搞自己了,
所以就只寫了一個單一功能的程式;p

謝謝分享，雖然還沒使用到lisp，但早有耳聞，想必這是一個趨勢，小的要來好好的研究了。

多謝RyanGuo大大提供LISP分享，請以後也不吝多多分享...

雖然還看不太懂，遇是謝謝你的分亨！

哇哇!!

謝謝您的分享~

小弟想學lisp但是不知道改從何學起~

不知道大大有沒有好的建議呢?

非常棒啊，又有另一種思維去作圖了。
個人也好想在LISP上有些成長

謝謝分享   

感謝版主的犧牲與奉獻

感謝大大分享，還不知道甚麼用處說，先下載備用。

謝謝 RyanGuo 師兄分享..................................