[討論]版筋搭接長度驗算LISP
3 posters
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
[討論]版筋搭接長度驗算LISP
- 代碼:
; 本程式為版筋搭接長度驗算輔助小工具
; 支援軟體版本("AutoCAD")
; 設計者:Devin,Chou
; 版權所有,歡迎使用
; Rev.2(2016/10/29-11/03)
; 進版說明: 1.程式編碼更新 2.程式預設值,搭接長 3.判斷式,單[S]/複[M] 4.版筋長度樣式判斷
(defun C:slck (/ LD SL_D Srb Srb_1 Srb_N Srb_NL lc_s lc_m
Srb_P Srb_L Srb_LS Srb_LE LD_P LD_S C_L )
(setvar "cmdecho" 0 )
(setq Srb_P 1 Srb_LS 0 Srb_NL '() )
(if (= 35_A nil )
(setq 35_A 0 )) ; if.end
(setq LD
(getint
(strcat "\n請輸入搭接長度" "<" (itoa 35_A ) ">:" )))
(if (= LD nil )
(setq LD 35_A )) ; if.end
(setq 35_A LD )
(setq SL_D
(getdist "\n請輸入檢核範圍(點選距離or輸入數值)[基點]:" ))
(princ
(strcat "\n版(檢核範圍):" (itoa (fix SL_D )) "cm" ))
(setq Srb
(entsel
(strcat "\n請選取版筋" "<" (itoa Srb_P ) ">:" )))
(setq Srb_N
(car Srb ))
(redraw Srb_N 3 )
(setq Srb_NL
(cons Srb_N Srb_NL ))
(setq Srb_1
(cdr
(assoc 1
(entget
(car Srb )))))
(if (wcmatch Srb_1 "*x*,*X*,*`**" )
(setq lc_s 0 )
(setq lc_m 0 )) ; if.end
(while (= lc_s 0 )
(slck_sp )
(setq Srb_LS
(* 2 Srb_L ))
(setq lc_s 1 )) ; while-lc_s.end
(while (= lc_m 0 )
(slck_sp )
(setq Srb_LS
(+ Srb_L Srb_LS ))
(setq Srb_P
(1+ Srb_P ))
(setq Srb
(entsel
(strcat "\n請選取版筋" "<" (itoa Srb_P ) ">:" )))
(if (/= Srb nil )
(progn
(setq Srb_1 (cdr (assoc 1 (entget (car Srb )))))
(setq Srb_N (car Srb ))
(redraw Srb_N 3 )
(setq Srb_NL (cons Srb_N Srb_NL ))) ; progn.end
(setq lc_m 1 ))) ; if.end,while-lc_m.end
(if (= Srb_P 1 )
(setq Srb_P 2 LD_P 1 )
(setq Srb_P (1- Srb_P ) LD_P (1- Srb_P ))) ; if.end
(setq LD_S
(* LD_P LD ))
(setq Srb_LE
(- Srb_LS LD_S ))
(setq C_L
(- (fix SL_D ) 5 5 Srb_LE ))
(setq Srb_P (itoa Srb_P )
LD_P (itoa LD_P )
Srb_LE (itoa Srb_LE )
LD_S (itoa LD_S )
SL_D (itoa (- (fix SL_D ) 5 5 )))
(if (minusp C_L )
(alert
(strcat "搭接總長:" LD_S "cm," LD_P "處"
"\n版筋總長(扣搭接):" Srb_LE "cm," Srb_P "處"
"\n檢核範圍(頭尾扣5):" SL_D "cm"
"\n版筋總長 >= 檢核範圍:" (itoa (abs C_L )) "cm"
"\n符合" ))
(alert
(strcat "搭接總長:" LD_S "cm," LD_P "處"
"\n版筋總長(扣搭接):" Srb_LE "cm," Srb_P "處"
"\n檢核範圍(頭尾扣5):" SL_D "cm"
"\n版筋總長 < 檢核範圍:" (itoa (abs C_L )) "cm"
"\n不符合" ))) ; if.end
(foreach X Srb_NL (redraw X 4 ))
(prin1)
) ; slck.end
;----------分隔線----------;
(defun slck_sp (/ s1 s2 s3 )
(if (wcmatch Srb_1 "*+*" )
(setq s1
(1+
(vl-string-search "+" Srb_1 )))
(setq s1
(1+
(vl-string-search "-" Srb_1 )))) ; if,end
(setq s2
(vl-string-search "=" Srb_1 ))
(setq s3
(- s2 s1 ))
(setq Srb_L
(atoi
(substr Srb_1 (1+ s1 ) s3 )))
(prin1)
) ; slck_sp.end
(princ "\nC:slck(2版)")
(prin1)
這是小弟為了工作所需寫的LISP,
程式的使用上暫時沒問題,
只不過少了防呆功能!
請各位先進指教!
謝謝!
以下為使用說明影片...
- 附件
devinchou- 初級會員
- 文章總數 : 56
年齡 : 46
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 3
經驗值 : 4034
威望值 : 192
注冊日期 : 2015-02-15
vincent8759 likes this post
回復: [討論]版筋搭接長度驗算LISP
謝謝您再次熱心分享~
有需要的朋友記得回文感謝!
有需要的朋友記得回文感謝!
____________________________________________________________________________________
👉[訂購]AutoCAD圖塊大師課程(點我)👈
回復: [討論]版筋搭接長度驗算LISP
讚讚讚我需要這個程式先下載試用再回報謝謝提供
a258- 初級會員
- 文章總數 : 49
年齡 : 57
來自 : 桃園
職業 : 工
愛好 : 電腦
個性 : 自由
使用年資 : 1
使用版本 : 2008
積分 : 3
經驗值 : 5420
威望值 : 24
注冊日期 : 2010-07-10
回復: [討論]版筋搭接長度驗算LISP
請問我的版筋列示格式如下
#3 635x39@15
應該如何修正程式才能抓到數據
謝謝
#3 635x39@15
應該如何修正程式才能抓到數據
謝謝
a258- 初級會員
- 文章總數 : 49
年齡 : 57
來自 : 桃園
職業 : 工
愛好 : 電腦
個性 : 自由
使用年資 : 1
使用版本 : 2008
積分 : 3
經驗值 : 5420
威望值 : 24
注冊日期 : 2010-07-10
回復: [討論]版筋搭接長度驗算LISP
需要更改的是...a258 寫到:請問我的版筋列示格式如下
#3 635x39@15
應該如何修正程式才能抓到數據
謝謝
(if (wcmatch Srb_1 "*x*,*X*,*`**" )
這一行是控制版筋選取的...
以及副程式...
(defun slck_sp (/ s1 s2 s3 )
(if (wcmatch Srb_1 "*+*" )
(setq s1
(1+
(vl-string-search "+" Srb_1 )))
(setq s1
(1+
(vl-string-search "-" Srb_1 )))) ; if,end
(setq s2
(vl-string-search "=" Srb_1 ))
(setq s3
(- s2 s1 ))
(setq Srb_L
(atoi
(substr Srb_1 (1+ s1 ) s3 )))
副程式是抓選取到的版筋長度...
過幾天就放假了...
我再把程式改成你需要我擺上來...
devinchou- 初級會員
- 文章總數 : 56
年齡 : 46
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 3
經驗值 : 4034
威望值 : 192
注冊日期 : 2015-02-15
回復: [討論]版筋搭接長度驗算LISP
[quote="devinchou"]
; 版權所有,歡迎使用
; Rev.2(2016/10/29-11/03)
; 進版說明: 1.程式編碼更新 2.程式預設值,搭接長 3.判斷式,單[S]/複[M] 4.版筋長度樣式判斷
(defun C:slck (/ LD SL_D Srb Srb_1 Srb_N Srb_NL lc_s lc_m
Srb_P Srb_L Srb_LS Srb_LE LD_P LD_S C_L )
(setvar "cmdecho" 0 )
(setq Srb_P 1 Srb_LS 0 Srb_NL '() )
(if (= 35_A nil )
(setq 35_A 0 )) ; if.end
(setq LD
(getint
(strcat "\n請輸入搭接長度" "<" (itoa 35_A ) ">:" )))
(if (= LD nil )
(setq LD 35_A )) ; if.end
(setq 35_A LD )
(setq SL_D
(getdist "\n請輸入檢核範圍(點選距離or輸入數值)[基點]:" ))
(princ
(strcat "\n版(檢核範圍):" (itoa (fix SL_D )) "cm" ))
(setq Srb
(entsel
(strcat "\n請選取版筋" "<" (itoa Srb_P ) ">:" )))
(setq Srb_N
(car Srb ))
(redraw Srb_N 3 )
(setq Srb_NL
(cons Srb_N Srb_NL ))
(setq Srb_1
(cdr
(assoc 1
(entget
(car Srb )))))
(if (wcmatch Srb_1 "*s*,*S*,*`**" )
(setq lc_s 0 )
(setq lc_m 0 )) ; if.end
(while (= lc_s 0 )
(slck_sp )
(setq Srb_LS
(* 2 Srb_L ))
(setq lc_s 1 )) ; while-lc_s.end
(while (= lc_m 0 )
(slck_sp )
(setq Srb_LS
(+ Srb_L Srb_LS ))
(setq Srb_P
(1+ Srb_P ))
(setq Srb
(entsel
(strcat "\n請選取版筋" "<" (itoa Srb_P ) ">:" )))
(if (/= Srb nil )
(progn
(setq Srb_1 (cdr (assoc 1 (entget (car Srb )))))
(setq Srb_N (car Srb ))
(redraw Srb_N 3 )
(setq Srb_NL (cons Srb_N Srb_NL ))) ; progn.end
(setq lc_m 1 ))) ; if.end,while-lc_m.end
(if (= Srb_P 1 )
(setq Srb_P 2 LD_P 1 )
(setq Srb_P (1- Srb_P ) LD_P (1- Srb_P ))) ; if.end
(setq LD_S
(* LD_P LD ))
(setq Srb_LE
(- Srb_LS LD_S ))
(setq C_L
(- (fix SL_D ) 5 5 Srb_LE ))
(setq Srb_P (itoa Srb_P )
LD_P (itoa LD_P )
Srb_LE (itoa Srb_LE )
LD_S (itoa LD_S )
SL_D (itoa (- (fix SL_D ) 5 5 )))
(if (minusp C_L )
(alert
(strcat "搭接總長:" LD_S "cm," LD_P "處"
"\n版筋總長(扣搭接):" Srb_LE "cm," Srb_P "處"
"\n檢核範圍(頭尾扣5):" SL_D "cm"
"\n版筋總長 >= 檢核範圍:" (itoa (abs C_L )) "cm"
"\n符合" ))
(alert
(strcat "搭接總長:" LD_S "cm," LD_P "處"
"\n版筋總長(扣搭接):" Srb_LE "cm," Srb_P "處"
"\n檢核範圍(頭尾扣5):" SL_D "cm"
"\n版筋總長 < 檢核範圍:" (itoa (abs C_L )) "cm"
"\n不符合" ))) ; if.end
(foreach X Srb_NL (redraw X 4 ))
(prin1)
) ; slck.end
;----------分隔線----------;
(defun slck_sp (/ s1 s2 s3 )
(if (wcmatch Srb_1 "*+*" )
(setq s1
(1+
(vl-string-search "+" Srb_1 )))
(setq s1
(1+
(vl-string-search " " Srb_1 )))) ; if,end
(setq s2
(vl-string-search "x" Srb_1 ))
(setq s3
(- s2 s1 ))
(setq Srb_L
(atoi
(substr Srb_1 (1+ s1 ) s3 )))
(prin1)
) ; slck_sp.end
(princ "\nC:slck(2版)")
(prin1)
我自己修改成如下,目前可以正確抓到我的格式了,但不知程式是否正確,謝謝你devinchou 寫到:過幾天就放假了...
我再把程式改成你需要我擺上來...
; 版權所有,歡迎使用
; Rev.2(2016/10/29-11/03)
; 進版說明: 1.程式編碼更新 2.程式預設值,搭接長 3.判斷式,單[S]/複[M] 4.版筋長度樣式判斷
(defun C:slck (/ LD SL_D Srb Srb_1 Srb_N Srb_NL lc_s lc_m
Srb_P Srb_L Srb_LS Srb_LE LD_P LD_S C_L )
(setvar "cmdecho" 0 )
(setq Srb_P 1 Srb_LS 0 Srb_NL '() )
(if (= 35_A nil )
(setq 35_A 0 )) ; if.end
(setq LD
(getint
(strcat "\n請輸入搭接長度" "<" (itoa 35_A ) ">:" )))
(if (= LD nil )
(setq LD 35_A )) ; if.end
(setq 35_A LD )
(setq SL_D
(getdist "\n請輸入檢核範圍(點選距離or輸入數值)[基點]:" ))
(princ
(strcat "\n版(檢核範圍):" (itoa (fix SL_D )) "cm" ))
(setq Srb
(entsel
(strcat "\n請選取版筋" "<" (itoa Srb_P ) ">:" )))
(setq Srb_N
(car Srb ))
(redraw Srb_N 3 )
(setq Srb_NL
(cons Srb_N Srb_NL ))
(setq Srb_1
(cdr
(assoc 1
(entget
(car Srb )))))
(if (wcmatch Srb_1 "*s*,*S*,*`**" )
(setq lc_s 0 )
(setq lc_m 0 )) ; if.end
(while (= lc_s 0 )
(slck_sp )
(setq Srb_LS
(* 2 Srb_L ))
(setq lc_s 1 )) ; while-lc_s.end
(while (= lc_m 0 )
(slck_sp )
(setq Srb_LS
(+ Srb_L Srb_LS ))
(setq Srb_P
(1+ Srb_P ))
(setq Srb
(entsel
(strcat "\n請選取版筋" "<" (itoa Srb_P ) ">:" )))
(if (/= Srb nil )
(progn
(setq Srb_1 (cdr (assoc 1 (entget (car Srb )))))
(setq Srb_N (car Srb ))
(redraw Srb_N 3 )
(setq Srb_NL (cons Srb_N Srb_NL ))) ; progn.end
(setq lc_m 1 ))) ; if.end,while-lc_m.end
(if (= Srb_P 1 )
(setq Srb_P 2 LD_P 1 )
(setq Srb_P (1- Srb_P ) LD_P (1- Srb_P ))) ; if.end
(setq LD_S
(* LD_P LD ))
(setq Srb_LE
(- Srb_LS LD_S ))
(setq C_L
(- (fix SL_D ) 5 5 Srb_LE ))
(setq Srb_P (itoa Srb_P )
LD_P (itoa LD_P )
Srb_LE (itoa Srb_LE )
LD_S (itoa LD_S )
SL_D (itoa (- (fix SL_D ) 5 5 )))
(if (minusp C_L )
(alert
(strcat "搭接總長:" LD_S "cm," LD_P "處"
"\n版筋總長(扣搭接):" Srb_LE "cm," Srb_P "處"
"\n檢核範圍(頭尾扣5):" SL_D "cm"
"\n版筋總長 >= 檢核範圍:" (itoa (abs C_L )) "cm"
"\n符合" ))
(alert
(strcat "搭接總長:" LD_S "cm," LD_P "處"
"\n版筋總長(扣搭接):" Srb_LE "cm," Srb_P "處"
"\n檢核範圍(頭尾扣5):" SL_D "cm"
"\n版筋總長 < 檢核範圍:" (itoa (abs C_L )) "cm"
"\n不符合" ))) ; if.end
(foreach X Srb_NL (redraw X 4 ))
(prin1)
) ; slck.end
;----------分隔線----------;
(defun slck_sp (/ s1 s2 s3 )
(if (wcmatch Srb_1 "*+*" )
(setq s1
(1+
(vl-string-search "+" Srb_1 )))
(setq s1
(1+
(vl-string-search " " Srb_1 )))) ; if,end
(setq s2
(vl-string-search "x" Srb_1 ))
(setq s3
(- s2 s1 ))
(setq Srb_L
(atoi
(substr Srb_1 (1+ s1 ) s3 )))
(prin1)
) ; slck_sp.end
(princ "\nC:slck(2版)")
(prin1)
a258- 初級會員
- 文章總數 : 49
年齡 : 57
來自 : 桃園
職業 : 工
愛好 : 電腦
個性 : 自由
使用年資 : 1
使用版本 : 2008
積分 : 3
經驗值 : 5420
威望值 : 24
注冊日期 : 2010-07-10
AutoCAD顧問 :: 技術(發言等級:一般會員) :: :: 進階討論
第1頁(共1頁)
這個論壇的權限:
您 無法 在這個版面回復文章