[分享]標註x、y、z座標LISP

由 **蔡欣恬** 2017-05-22, 13:31

主題回顧 :

第一次發分享文不知道格式有沒有寫對

由於AUTOCAD設定的座標式標註X值與Y值須分開標註很不好用，
最近剛剛學習了如何寫LISP程式，參考了一些前輩們的程式後，自己也寫了一個標註X，Y，Z 值的LISP，分享給大家，寫得不好的地方也希望大家不吝賜教。
程式的功能如下:
1.設定一個標註點位的圖層
2.以引線標註點位的X,Y,Z值

操作畫面如下:

▼下載網址(*回覆可見*):

Tiger&蘋果爸寫到: 謝謝熱心程式分享~< 積分 +1>
[公告]關於團隊成員的回文及貢獻

由 **ahorng** 2020-08-13, 15:44

我也來看看

由 **qaz914133** 2020-08-21, 13:56

謝謝你的分享~剛好可以拿來試試看

由 **Ggsimida** 2020-08-27, 13:44

DL來試看看吧

由 **a199417** 2020-09-17, 21:32

感謝大大無私分享

由 **撩貓不撩人** 2020-10-08, 14:08

感謝大大的分享
下載來測試

由 **roch2034** 2020-10-22, 15:44

剛好要用到, 一搜尋馬上就看到有人分享
真是太感謝了!

由 **adsl666** 2020-11-08, 18:12

非常感謝無私地分享..工作上面會用到

由 **f933021** 2020-11-30, 09:43

感謝無私分享剛好有需要用到，感謝

由 **stantseng** 2020-12-22, 14:30

非常感謝版主的熱情分享

由 **tunalai** 2021-01-06, 16:53

感謝分享謝謝提供

由 **許哲嘉** 2021-01-08, 13:48

感謝分享~下載試用~

由 **shackle_2005** 2021-01-08, 16:55

;標註點位NE值與高程

(defun C:NEZP(/ Layername Point1 Point_N Point_E Point_Z TXT_X TXT_Y TXT_Z UCS_N UCS_E UCS_Z Point2 Set_style)
(Prompt "這是一個繪製引線標註點位NE值與高程的指令")
;新增圖層;
;(setq Layername (getstring"\n請設定標註點位的圖層名稱: "))
;(MakeLayer Layername 2);;;新建圖層(MakeLayer "圖層名稱" 顏色)

;主程式;
(SETVAR "OSNAPCOORD" 1); 設定座標資料輸入優先權為鍵盤輸入
(setq Point1 (getpoint "\n請點選測量點位置: "))
(setq Point_N (car Point1)) ; N值
(setq Point_E (cadr Point1)) ;E值
(setq Point_Z (caddr Point1)) ;高程值
(setq TXT_X (rtos Point_N 2 3));將實數轉換成字串[小數模式][精度小數點下三位]
(setq TXT_Y (rtos Point_E 2 3))
(setq TXT_Z (rtos Point_Z 2 3))
(setq UCS_N (strcat "N " TXT_Y));合併字串:N+TXT_Y
(setq UCS_E (strcat "E " TXT_X));合併字串:N+TXT_X
(setq UCS_Z (strcat "EL+" TXT_Z));合併字串:N+TXT_Z
(setq Set_style(tblsearch "style" "standard"));設定文字型式為coordinate_value
(if (= Set_style nil)
(command "style" "standard" "arial" "" "" "" )
)
(setq Point2 (getpoint "\n請點選文字放置位置: "))
(command "LEADER" Point1 Point2 "" UCS_N UCS_E UCS_Z "");繪製引線
(PRINC)
)
;;;;;;;;;;;;;新增圖層副程式;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN MakeLayer (#LayName #LayColor);;;用法(MakeLayer "圖層名稱" 顏色)
(SETQ LAYKEY (TBLSEARCH "Layer" #LayName))
(IF (= LAYKEY nil);;;假設沒有此圖層
(COMMAND "LAYER" "M" #LayName "C" #LayColor #LayName "");;;如果沒有圖層執行此行新建該圖層
(COMMAND "LAYER" "T" #LayName "S" #LayName "U" #LayName "C" #LayColor #LayName "");;;如果有圖層執行此行
)
(PRINC)
)

由 **Tiger&蘋果爸** 2021-01-08, 17:08

shackle_2005 寫到:個人意見, 這麼簡單的程式要回覆還要密碼, 110 個分享有討論回應什麼 ?? 好好笑喔, 哈哈哈哈.

別這麼說~
我覺得不是簡不簡單的問題，不管多簡單我也會設置回覆可見，因為有很多路過潛水客拿了東西就走，減少了人與人善意的回應互動...
我們是互助論壇希望他家多多支持與互動~

由 **shackle_2005** 2021-01-08, 17:14

那為什麼我從以前到現在, 在這裏分享的小程式從來都不需要回覆, 也不用密碼, 也不用感謝 ?? 如果有進一步的問題再來討論就好了, 這麼簡單的問題都不能理解 ?? 110 個分享都是在感謝, 這麼這麼這麼這麼 .... 小的程式抄課本有都可以做的出來了, 要感謝上帝還是觀世音菩薩 ??

由 **Tiger&蘋果爸** 2021-01-08, 17:32

shackle_2005 寫到:那為什麼我從以前到現在, 在這裏分享的小程式從來都不需要回覆, 也不用密碼, 也不用感謝 ?? 如果有進一步的問題再來討論就好了, 這麼簡單的問題都不能理解 ?? 110 個分享都是在感謝, 這麼這麼這麼這麼 .... 小的程式抄課本有都可以做的出來了, 要感謝上帝還是觀世音菩薩 ??

shackle_2005大，您的貢獻及無私分享我與大家都很感謝~
我們也知道你常常熱心幫助~
謝謝你支持魚幫水水幫魚理想!
另外，您提到的問題，我想每個人分享的心境與方式都不同，在這裡我們都是持正面的態度來看待~
希望大家能快快樂樂在這裡互動及討論~
希望您能了解!