AutoCAD顧問
還沒有註冊嗎...即日起免費註冊，所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊，所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.
AutoCAD顧問

專屬 AutoCAD 線上個人顧問，是您學習路上最佳的良師益友，也是職場中最即時的支援後盾！

[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe1-113[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ioaoe110[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-310[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oiu15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-211[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ia15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao10[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Uos15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 BPl3tjj[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ziao1510
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oo-2-110[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Zuoiy_10[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao11[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Iyb_1510[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe1-112[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Uos15011[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe2da10[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe2da11[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe10

[討論]有高手可否幫忙測試LISP..語法有錯誤嗎

3 posters

AutoCAD顧問 :: 技術(發言等級:一般會員) ::   :: 進階討論

向下

[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Empty [討論]有高手可否幫忙測試LISP..語法有錯誤嗎

發表 由 t8641253 2014-07-27, 10:09

第一個程式
代碼:
(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,只要選取物件跟設基準點,直接就變圖塊的程式,謝謝
附件
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Attachment
程式.zip 您無權下載這里的附件。(2 Kb) 下載 9 次

____________________________________________________________________________________
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ioaoe110 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Zuoiy_10 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-211 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao11 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Iyb_1510
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao10 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 BPl3tjj.png [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ziao1510 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oo-2-110 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oooa_110
t8641253
t8641253
初級會員
初級會員

文章總數 : 60
年齡 : 47
來自 : Taipei
職業 : 金屬外牆
愛好 : 電腦
個性 : 隨和
使用年資 : 新手初學
使用版本 : AutoCAD2016
積分 : 1
經驗值 : 4896
威望值 : 6
注冊日期 : 2012-04-22
顧問外掛程式 經典問與答讀者 男 處女座 蛇

回頂端 向下

[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Empty 回復： [討論]有高手可否幫忙測試LISP..語法有錯誤嗎

發表 由 judyyai 2014-08-01, 08:56

不會~只好
幫頂~讓此文浮出來~

____________________________________________________________________________________
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ioaoe110 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Zuoiy_10 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-211 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao11 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe10
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao10 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 BPl3tjj.png [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ziao1510 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oo-2-110 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe1-111
judyyai
judyyai
管理顧問
管理顧問

文章總數 : 7786
年齡 : 47
來自 : 台南
職業 : 機械製圖
愛好 : 電腦相關
個性 : think too much...
使用年資 : 10↑
使用版本 : AC2019(開始於2019年底末月)
AutoCAD基礎篇等級 : 10星級
積分 : 393
最佳解答 : 1
經驗值 : 30445
威望值 : 3610
發帖精華 : 2
回帖精華 : 4
注冊日期 : 2008-11-19
2D基礎函授 3D基礎函授 顧問外掛程式 經典問與答讀者 藍鵲2號
2009聚會勳章 串連貼紙成功 女 巨蟹座 蛇

回頂端 向下

[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Empty 回復： [討論]有高手可否幫忙測試LISP..語法有錯誤嗎

發表 由 ginse0727 2014-08-14, 12:49

不好意思,沒空幫忙測試程式!
只能先解決你的第三點,分享我自己寫的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)
  )

____________________________________________________________________________________
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ioaoe110 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Zuoiy_10 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-211 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao11 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Iyb_1510
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao10 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 BPl3tjj.png [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ziao1510 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oo-2-110 [討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oooa_110
ginse0727
ginse0727
高級會員
高級會員

文章總數 : 256
年齡 : 50
來自 : 台北巿
職業 : 帷幕牆
愛好 : 電玩,漫畫,網路小說
個性 : 宅男/正直/死腦筋
使用年資 : 退伍後工作迄今,10年以上
使用版本 : 2012
積分 : 14
經驗值 : 6829
威望值 : 500
發帖精華 : 1
注冊日期 : 2010-07-13
經典問與答讀者 藍鵲61號
2011聚會勳章 男 獅子座 虎

回頂端 向下

回頂端

AutoCAD顧問 :: 技術(發言等級:一般會員) ::   :: 進階討論

 
這個論壇的權限：
您 無法 在這個版面回復文章
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe1-113[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ioaoe110[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-310[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oiu15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 2020-211[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ia15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao10[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Uos15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 BPl3tjj[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Ziao1510
[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe15010[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Oo-2-110[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Zuoiy_10[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aizyao11[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Iyb_1510[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe1-112[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Uos15011[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe2da10[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe2da11[討論]有高手可否幫忙測試LISP..語法有錯誤嗎 Aoe10