[討論]有高手可否幫忙測試LISP..語法有錯誤嗎
3 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎
第一個程式
第三是否有人可以幫小弟寫一個快速製作圖塊的LISP,只要選取物件跟設基準點,直接就變圖塊的程式,謝謝
- 代碼:
(defun liperr(s)
(setq *error* old)
(setvar "OSMODE" osmode)
(setvar "CLAYER" clayer)
(princ)
)
(defun setitem(val tablefile)
(if val
(progn
(setq file (open tablefile "r")
id (1+ (atoi val))
)
(repeat id
(setq str (read-line file))
)
(close file)
(setq H (atof (substr str 1 3))
A (atof (substr str 4 4))
C (atof (substr str 8 4))
t (atof (substr str 12))
)
)
)
)
(defun readlist(tablefile table_id)
(setq file (open tablefile "r"))
(start_list table_id)
(while (setq str (read-line file)) (add_list str))
(end_list)
(close file)
)
(defun popimage(imagekey imagefile)
(start_image imagekey)
(slide_image 0 0 (dimx_tile imagekey) (dimy_tile imagekey) imagefile)
(end_image)
)
(defun clerr()
(set_tile "error" "")
(setq item nil)
)
(defun seteditbox(e1 e2 e3)
(setq e1 (rtos e1 2 1)
e2 (rtos e2 2 1)
e3 (rtos e3 2 1)
)
(set_tile "p_h" e1)
(set_tile "p_a" e2)
(set_tile "p_t" e3)
)
(defun box_on_off(on_off)
(cond
((= 1 on_off)
(mode_tile "p_h" 0)
(mode_tile "p_a" 0)
(mode_tile "p_t" 0)
)
((= 0 on_off)
(mode_tile "p_h" 1)
(mode_tile "p_a" 1)
(mode_tile "p_t" 1)
)
)
)
(defun draw(H A T)
(setq pts (getpoint "\nPick Lip Channel Steel start point : ")
pt1 (polar pts 0 (- (/ H 2) t))
pt2 (polar pt1 (* 0.25 pi) (sqrt (* 2 t t)))
pt3 (polar pt2 (* 0.5 pi) (- A t))
pt4 (polar pt3 pi t)
pt5 (polar pt4 (* 1.5 pi) (- A t))
pt6 (polar pt5 pi (- H (* 2 t)))
pt7 (polar pt6 (* 0.5 pi) (- A t))
pt8 (polar pt7 pi t)
pt9 (polar pt8 (* 1.5 pi) (- A t))
pt10 (polar pt9 (* 1.75 pi) (sqrt (* 2 t t)))
)
(setvar "OSMODE" 0)
(command "PLINE" pts pt1 "A" "A" "90" pt2 "L" pt3 pt4 pt5 pt6 pt7 pt8 pt9
"A" "A" "90" pt10 "L" "CL")
(command "ROTATE" "L" "" pts pause)
(command "HATCH" "ANSI31" "80" "" "L" "")
)
(defun chkerr()
(if (or (> (* 2 C) H) (> (* 2 t) H) (> (* 2 t) A))
(progn
(set_tile "error" "Invalid parameter !! Please try again ....")
(setq flag nil)
)
(setq flag T)
)
)
(defun C:U_BEAM()
(setq old *error* *error* liperr)
(setq osmode (getvar "OSMODE"))
(setq clayer (getvar "CLAYER"))
(setq tabfile (findfile "U_BEAM.TAB"))
(if (tblsearch "LAYER" "STEEL")(setvar "CLAYER" "STEEL"))
(setvar "CLAYER" "STEEL")
(setvar "LIMCHECK" 0)
(setvar "CMDECHO" 0)
(setq dcl (load_dialog "U_BEAM"))
(if (null (new_dialog "U_BEAM" dcl))(exit))
(readlist tabfile "U_BEAM_id")
(popimage "U_BEAM_image" "U_BEAM")
(setq H 0 A 0 C 0 t 0)
(seteditbox H A t)
(box_on_off 0)
(action_tile "U_BEAM_id" "(clerr)(setq item $value)
(setitem item tabfile)(seteditbox H A t)")
(action_tile "user" "(clerr)(box_on_off (atoi $value))")
(action_tile "p_st" "(clerr)(if (chkerr)(done_dialog 1))")
(action_tile "p_h" "(clerr)(setq H (atof $value))")
(action_tile "p_a" "(clerr)(setq A (atof $value))")
(action_tile "p_t" "(clerr)(setq t (atof $value))")
(action_tile "cancel" "(setq flag nil)(done_dialog 0)")
(start_dialog)
(if flag
(progn (setitem item tabfile)(draw H A t))
(princ "*CANCEL*")
)
(unload_dialog dcl)
(setvar "OSMODE" osmode)
(setvar "CLAYER" clayer)
(setq *error* old)
(princ)
)
第二個程式
(defun liperr(s)
(setq *error* old)
(setvar "OSMODE" osmode)
(setvar "CLAYER" clayer)
(princ)
)
(defun setitem(val tablefile sel)
(if val
(progn
(setq file (open tablefile "r"))
(if (= sel 1)(setq id (1+ (atoi val)))(setq id (+ 300 (atoi val))))
(repeat id
(setq str (read-line file))
)
(close file)
(setq H (atof (substr str 1 5))
W (atof (substr str 6 11))
t (atof (substr str 13))
)
)
)
)
(defun readlist(tablefile table_id sel)
(setq file (open tablefile "r"))
(start_list table_id)
(if (= sel 0)
(repeat 298 (setq str (read-line file)) (add_list str))
(progn
(repeat 299 (read-line file))
(while (setq str (read-line file)) (add_list str))
)
)
(end_list)
(close file)
)
(defun popimage(sel)
(start_image "O_BEAM_image")
(fill_image 0 0 (dimx_tile "O_BEAM_image") (dimy_tile "O_BEAM_image") -2)
(end_image)
(if (= sel 0)
(setq imagefile "O_BEAM")
(setq imagefile "O1_BEAM")
)
(start_image "O_BEAM_image")
(slide_image 0 0 (dimx_tile "O_BEAM_image") (dimy_tile "O_BEAM_image") imagefile)
(end_image)
)
(defun clerr()
(set_tile "error" "")
(setq item nil)
)
(defun seteditbox(e1 e2 e3)
(setq e1 (rtos e1 2 1)
e2 (rtos e2 2 1)
e3 (rtos e3 2 1)
)
(set_tile "p_h" e1)
(set_tile "p_w" e2)
(set_tile "p_t" e3)
)
(defun box_on_off(on_off)
(cond
((= 1 on_off)
(mode_tile "p_h" 0)
(mode_tile "p_w" 0)
(mode_tile "p_t" 0)
)
((= 0 on_off)
(mode_tile "p_h" 1)
(mode_tile "p_w" 1)
(mode_tile "p_t" 1)
)
)
)
(defun draw(H W T)
(setq pts (getpoint "\nPick O Channel Steel start point : ")
pt1 (polar pts 0 (/ W 2))
pt2 (polar pt1 (* 0.5 pi) H)
pt3 (polar pt2 pi W)
pt4 (polar pt3 (* 1.5 pi) H)
pt5 (polar pts (* 0.5 pi) t)
)
(setvar "OSMODE" 0)
(command "PLINE" pts pt1 pt2 pt3 pt4 "C")
(command "FILLET" "R" offinput "FILLET" "Polyline" (entlast))
(command "FILLET" "R" t "FILLET" "Polyline" (entlast))
(command "OFFSET" t pts pt5 "")
(command "ROTATE" "C" pt1 pt5 "" pts pause)
(command "HATCH" "ANSI31" "80" "" "C" pt1 pt5 "")
)
(defun chkerr()
(if (or (> (* 2 t) H) (> (* 2 t) W))
(progn
(set_tile "error" "Invalid parameter !! Please try again ....")
(setq flag nil)
)
(setq flag T)
)
)
(defun C:O_BEAM()
(setq selitem 1 old *error* *error* liperr)
(setq osmode (getvar "OSMODE"))
(setq clayer (getvar "CLAYER"))
(setq tabfile (findfile "O_BEAM.TAB"))
(if (tblsearch "LAYER" "STEEL")(setvar "CLAYER" "STEEL"))
(setvar "CLAYER" "STEEL")
(setvar "LIMCHECK" 0)
(setvar "CMDECHO" 0)
(setq dcl (load_dialog "O_BEAM"))
(if (null (new_dialog "O_BEAM" dcl))(exit))
(readlist tabfile "O_BEAM_id" 0)
(popimage 0)
(setq H 0 W 0 t 0)
(seteditbox H W t)
(box_on_off 0)
(action_tile "O_BEAM_id" "(clerr)(setq item $value)
(setitem item tabfile selitem)(seteditbox H W t)")
(action_tile "user" "(clerr)(box_on_off (atoi $value))")
(action_tile "O_BEAM_image" "(popimage selitem)(readlist tabfile \"O_BEAM_id\" selitem)
(if (= selitem 0)(setq selitem 1)(setq selitem 0))")
(action_tile "p_st" "(clerr)(if (chkerr)(done_dialog 1))")
(action_tile "p_h" "(clerr)(setq H (atof $value))")
(action_tile "p_w" "(clerr)(setq W (atof $value))")
(action_tile "p_t" "(clerr)(setq t (atof $value))")
(action_tile "cancel" "(setq flag nil)(done_dialog 0)")
(start_dialog)
(if flag
(progn (setitem item tabfile selitem)(draw H W t))
(princ "*CANCEL*")
)
(unload_dialog dcl)
(setvar "OSMODE" osmode)
(setvar "CLAYER" clayer)
(setq *error* old)
(princ)
)
第三是否有人可以幫小弟寫一個快速製作圖塊的LISP,只要選取物件跟設基準點,直接就變圖塊的程式,謝謝
- 附件
t8641253- 初級會員
- 文章總數 : 60
年齡 : 47
來自 : Taipei
職業 : 金屬外牆
愛好 : 電腦
個性 : 隨和
使用年資 : 新手初學
使用版本 : AutoCAD2016
積分 : 1
經驗值 : 4853
威望值 : 6
注冊日期 : 2012-04-22
回復: [討論]有高手可否幫忙測試LISP..語法有錯誤嗎
不會~只好
幫頂~讓此文浮出來~
幫頂~讓此文浮出來~
judyyai- 管理顧問
- 文章總數 : 7786
年齡 : 47
來自 : 台南
職業 : 機械製圖
愛好 : 電腦相關
個性 : think too much...
使用年資 : 10↑
使用版本 : AC2019(開始於2019年底末月)
AutoCAD基礎篇等級 : 10星級
積分 : 393
最佳解答 : 1
經驗值 : 30402
威望值 : 3610
發帖精華 : 2
回帖精華 : 4
注冊日期 : 2008-11-19
回復: [討論]有高手可否幫忙測試LISP..語法有錯誤嗎
不好意思,沒空幫忙測試程式!
只能先解決你的第三點,分享我自己寫的LSP,給大家參考.
;;;command:BB 不訂圖塊名稱,製作成圖塊
;;;command:BBB 自訂圖塊名稱,製作成圖塊
只能先解決你的第三點,分享我自己寫的LSP,給大家參考.
;;;command:BB 不訂圖塊名稱,製作成圖塊
;;;command:BBB 自訂圖塊名稱,製作成圖塊
- 代碼:
(defun c:bb(/ blk pt)
(prompt "選取要製作成圖塊的物件")
(setq blk (ssget))
(setq pt (getpoint "\n插入點: "))
(startlsp)
(command "copybase" pt blk "")
(command "pasteblock" pt)
(command "erase" blk "")
(endlsp)
)
(defun c:bbb(/ blk pt bname)
(prompt "選取要製作成圖塊的物件")
(setq blk (ssget))
(setq pt (getpoint "\n插入點: "))
(startlsp)
(setq bname (getstring "\n輸入圖塊名稱: "))
(command "-block" bname pt blk "")
(command "-insert" bname pt 1 1 0)
(endlsp)
)
(defun startlsp()
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq oldlay (getvar "clayer"))
)
(defun endlsp()
(setvar "osmode" oldos)
(setvar "clayer" oldlay)
)
ginse0727- 高級會員
- 文章總數 : 256
年齡 : 50
來自 : 台北巿
職業 : 帷幕牆
愛好 : 電玩,漫畫,網路小說
個性 : 宅男/正直/死腦筋
使用年資 : 退伍後工作迄今,10年以上
使用版本 : 2012
積分 : 14
經驗值 : 6786
威望值 : 500
發帖精華 : 1
注冊日期 : 2010-07-13
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章