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

[已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

上一篇主題 下一篇主題 向下

[已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 box888 于 2010-10-07, 03:44

請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯
有誰幫我看哪邊出問題嗎?
謝謝

(defun C:WALL-C (/ f1 p4 f2 c e p1 p3 p2 a )
(vmon)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(command "fillet" "R" 0)
(setq f1 nil)
(setq p4 nil)
(setq f2 nil)
(setq f3 nil)
(setq a1 (* 0.5 pi))
(setq c 0)
(setq e 3)
(setq s (getint "\nSelect <1>Left <2>Center <3>Right ="))
(if (= dfv nil) (setq dfv 24))
(prompt "\nWidth <")(princ dfv)(princ ">=")
(setq wth (getdist))
(if (= wth nil) (setq wth dfv))
(setq dfv wth)
(setq p1 (getpoint "\nFrom point:"))
(while e
(if (/= p3 nil) (setq f1 p3))
(if (> c 1)
(setq f1 (polar p3 a wth))
)
(setq p2 (getpoint p1 "\nTo point:" ))
(setq c (+ c 1))
(setq a (angle p1 p2))
(cond ((= s 1)
(setq p3 (polar p1 (+ a a1) wth))
(setq p4 (polar p2 (+ a a1) wth))
)
((= s 2)
(setq p1 (polar p1 (+ a a1) (/ wth 2.0)))
(setq p2 (polar p2 (+ a a1) (/ wth 2.0)))
(setq p3 (polar p1 (- a a1) wth))
(setq p4 (polar p2 (- a a1) wth))
)
((= s 3)
(setq p3 (polar p1 (- a a1) wth))
(setq p4 (polar p2 (- a a1) wth))
)
)
(setq aa (angle p3 p4))
(command "line" p1 p2 "")
(command "line" p3 p4 "")
(setq f2 p4)
(setq f4 p2)
(setvar "pickbox" 1)
(if (and (/= f1 nil) (/= a b) (/= aa bb))(command "fillet" f1 f2))
(if (and (/= f3 nill) (/= a b) (/= aa bb))
(command "fillet" f3 f4)
)
(setvar "pickbox" 3)
(if (= s 2) (setq p2 (polar p2 (- a a1) (/ wth 2.0))))
(setq f3 (polar p1 a wth))
(setq b a)
(setq bb aa)
(setq p1 p2)
) 愛哭
(princ)
)



Tiger&蘋果爸 在 2011-01-16, 10:51 作了第 2 次修改 (原因 : 更改主題顏色為無)
avatar
box888
一般會員
一般會員

文章總數 : 16
年齡 : 46
來自 : 台北
職業 : 設計
愛好 : 電影
個性 : 一般
使用年資 : 10
使用版本 : 2010
經驗值 : 2655
威望值 : 9
注冊日期 : 2010-09-24
藍鵲384號
男 獅子座 豬

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 pizg 于 2010-10-15, 10:29

你的問題出在這兒
--> (command "fillet" "R" 0)
它應該改成
--> (command "fillet" "R" 0 "")
在這兒順便提醒你一下,
你必須非常瞭解AutoCAD因版本之不同而產生的指令差異,
許多外掛程式之所以因AutoCAD改版而不能使用,
大多是出在AutoCAD的指令變異.
我在這兒舉幾個因版本不同而必須注意的指令:

LAYER
COPY
FILLET
TEXT
....
avatar
pizg
高級會員
高級會員

文章總數 : 253
年齡 : 52
來自 : 桃園縣
職業 : 建築設計;程式設計
愛好 : 音樂;攝影;繪畫;棋奕;電腦
個性 : 隨和
使用年資 : 20↑
使用版本 : 2010
積分 : 10
經驗值 : 4089
威望值 : 320
發帖精華 : 1
注冊日期 : 2010-04-16
串連貼紙成功 男 摩羯座 龍

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 suny999 于 2010-10-17, 03:35

pizq說的對,如果你不想改太多以前別人寫的程式的話,你可以試看看在出問題的那一行前面加下面這行:
(INITCOMMANDVERSION 1)
就可以相容舊版的ACAD語法。

順便說一下,用系統參數(setvar "filletrad" 1)會比用(command "fillet" "r" 0.0 "")更具有版本相容性。
avatar
suny999
一般會員
一般會員

文章總數 : 13
年齡 : 36
來自 : 台北
職業 : 結構技師
愛好 : 寫程式
個性 : 善良
使用年資 : 2年
使用版本 : 2012
經驗值 : 3160
威望值 : 27
注冊日期 : 2009-05-12
男 摩羯座 猴

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 box888 于 2011-01-15, 07:54

謝謝各位的回覆不過問題好像還是沒解決
再次感謝各位 微笑
avatar
box888
一般會員
一般會員

文章總數 : 16
年齡 : 46
來自 : 台北
職業 : 設計
愛好 : 電影
個性 : 一般
使用年資 : 10
使用版本 : 2010
經驗值 : 2655
威望值 : 9
注冊日期 : 2010-09-24
藍鵲384號
男 獅子座 豬

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 box888 于 2011-01-15, 08:07

分享一個算坪面積的lisp(mm)
*******************************
(defun c:pinin()
(setq ssn(car(entsel "\n選取封閉物件: ")))
(command "area" "o" ssn)
(setq aa (getvar "area"))
(setq aa1 (/ (* aa 0.3025) 1000000))
(setq aa2 (rtos aa1 2 4))
(alert (strcat "\n區域面積=" aa2 "坪"))
(PRINC "\N點取文字位置:")
(IF (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0)
(COMMAND "TEXT" PAUSE "" "" aa2)
(COMMAND "TEXT" PAUSE "" aa2)
)
)

分享一個算米平方面積的lisp(mm)
******************************(defun c:m2in()
(setq ssn(car(entsel "\n選取封閉物件: ")))
(command "area" "o" ssn)
(setq aa (getvar "area"))
(setq aa1 (/ (* aa 1) 1000000))
(setq aa2 (rtos aa1 2 4))
(alert (strcat "\n區域面積=" aa2 "米平方"))
(PRINC "\N點取文字位置:")
(IF (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0)
(COMMAND "TEXT" PAUSE "" "" aa2"米平方")
(COMMAND "TEXT" PAUSE "" aa2)
)
)
********************************************
計算數字總合的lisp
(defun c:sumtxt-1()
(setvar "cmdecho" 0) ;關閉LISP在指令區的操綽回應
(setq oldlay (getvar "clayer")) ;取出舊圖層設定值
(setq oldos (getvar "osmode")) ;取出舊物件鎖點設定值
(setvar "osmode" 0) ;關閉物件鎖點*避免物件鎖點干擾
(setq gum 1)
(prompt "\n框選統計數值:")
(setq ds (ssget '((0 . "*text"))))
(setq n (sslength ds)
i 0
j 0
numlist '()
sum 0
)
(repeat n
(setq en (ssname ds i))
(setq endata (entget en))
(setq num (cdr(assoc gum endata)))
(setq numlist (cons num numlist))
(setq i (1+ i))
)
(repeat (length numlist)
(setq num1 (atof (nth j numlist)))
(setq sum (+ num1 sum))
(setq j (1+ j))
)
(princ "\n選取數值總合為:")
(princ sum)
(alert (strcat "選取數值總合=" (rtos sum 2 4)))
(setvar "cmdecho" 1)
(setvar "clayer" oldlay)
(setvar "osmode" oldos)
(princ)
(PRINC "\N點取文字位置:")
(IF (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0)
(COMMAND "TEXT" PAUSE "" "" (rtos sum 2 4))
(COMMAND "TEXT" PAUSE "" (rtos sum 2 4))
)
)
***********************************************
畫牆的lisp不要理他了我放棄了 頭暈目眩
avatar
box888
一般會員
一般會員

文章總數 : 16
年齡 : 46
來自 : 台北
職業 : 設計
愛好 : 電影
個性 : 一般
使用年資 : 10
使用版本 : 2010
經驗值 : 2655
威望值 : 9
注冊日期 : 2010-09-24
藍鵲384號
男 獅子座 豬

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 box888 于 2011-01-15, 08:28

計算加總是參考lisp9-->ginse0727
修改的
avatar
box888
一般會員
一般會員

文章總數 : 16
年齡 : 46
來自 : 台北
職業 : 設計
愛好 : 電影
個性 : 一般
使用年資 : 10
使用版本 : 2010
經驗值 : 2655
威望值 : 9
注冊日期 : 2010-09-24
藍鵲384號
男 獅子座 豬

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 lsj 于 2011-01-16, 08:14

;;揣摩一下你想要的方式
(defun C:WALL-C ()
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)

(command "fillet" "R" 0 "")
(setq c 0)
(initget "1 2 3")
(setq s (getkword "\nSelect <1>Left <2>Center <3>Right ="))
(if (= dfv nil) (setq dfv 24))
(prompt "\nWidth <")(princ dfv)(princ ">=")
(setq wth (getdist))
(if (= wth nil) (setq wth dfv))
(setq dfv wth)
(setq p1 (getpoint "\nFrom point:"))
(while (setq p2 (getpoint p1 "\nTo point:" ))
(setq ang (angle p1 p2))
(cond ((= s "1")(setq p3 (polar p1 (+ ang (* 0.5 pi)) wth))
(setq p4 (polar p2 (+ ang (* 0.5 pi)) wth))
)
((= s "2")(setq p1_save p1)(setq p2_save p2)
(setq p1 (polar p1 (+ ang (* 0.5 pi)) (/ wth 2.0)))
(setq p2 (polar p2 (+ ang (* 0.5 pi)) (/ wth 2.0)))
(setq p3 (polar p1 (- ang (* 0.5 pi)) wth))
(setq p4 (polar p2 (- ang (* 0.5 pi)) wth))
)
((= s "3")(setq p3 (polar p1 (- ang (* 0.5 pi)) wth))
(setq p4 (polar p2 (- ang (* 0.5 pi)) wth))
)
)
(command "line" p1 p2 "")
(setq ss12 (entlast))
(command "line" p3 p4 "")
(setq ss34 (entlast))
(setq pm12 (mapcar '/ (mapcar '+ p1 p2) '(2.0 2.0)))
(setq pm34 (mapcar '/ (mapcar '+ p3 p4) '(2.0 2.0)))

(if (and (> c 0) (/= ang ang_old))
(progn
(command "fillet" (list ss12_old pm12_old) (list ss12 pm12))
(command "fillet" (list ss34_old pm34_old) (list ss34 pm34))
)
)
(if (= s "2")
(progn
(setq p1 p1_save)
(setq p2 p2_save)
)
)

(setq p1 p2)
(setq ang_old ang)
(setq ss12_old ss12)
(setq ss34_old ss34)
(setq pm12_old pm12)
(setq pm34_old pm34)
(setq c (+ c 1))
)
(setvar "osmode" osm)
(princ)
)
avatar
lsj
初級會員
初級會員

文章總數 : 43
年齡 : 52
來自 : 桃園
職業 : 營建工程
愛好 :
個性 :
使用年資 : 10↑
使用版本 : 2008
積分 : 2
經驗值 : 2913
威望值 : 104
注冊日期 : 2010-06-28
男 水瓶座 龍

回頂端 向下

回復: [已解決]請問這個畫牆線的lisp有甚麼地方出錯嗎最後都會出錯

發表 由 box888 于 2011-01-16, 10:43

謝謝 lsj 您的解答
這個lisp是我想要的結果
感謝各位
我只是對lisp有興趣不是很專業
謝謝各位的 嘻嘻
還有請問如果問題解決的要怎麼把[問題]改成[已解決]?
avatar
box888
一般會員
一般會員

文章總數 : 16
年齡 : 46
來自 : 台北
職業 : 設計
愛好 : 電影
個性 : 一般
使用年資 : 10
使用版本 : 2010
經驗值 : 2655
威望值 : 9
注冊日期 : 2010-09-24
藍鵲384號
男 獅子座 豬

回頂端 向下

上一篇主題 下一篇主題 回頂端


 
這個論壇的權限:
無法 在這個版面回復文章