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

[討論]版筋搭接長度驗算LISP

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

[討論]版筋搭接長度驗算LISP

發表 由 devinchou 于 2016-11-17, 14:24

代碼:
 ; 本程式為版筋搭接長度驗算輔助小工具
 ; 支援軟體版本("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,
程式的使用上暫時沒問題,
只不過少了防呆功能!
請各位先進指教!
謝謝!
以下為使用說明影片...
附件
35. 版筋-搭接長度驗算.zip 您無權下載這里的附件。(2 Kb) 下載 12 次
avatar
devinchou
初級會員
初級會員

文章總數 : 49
年齡 : 40
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 2
經驗值 : 1451
威望值 : 150
注冊日期 : 2015-02-15
男 天蝎座 蛇

回頂端 向下

回復: [討論]版筋搭接長度驗算LISP

發表 由 Tiger&蘋果爸 于 2016-11-18, 09:58

謝謝您再次熱心分享~
讚啦!!

有需要的朋友記得回文感謝!
過獎了

____________________________________________________________________________________
avatar
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 17316
年齡 : 41
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 15↑
使用版本 : AutoCAD 2016
經驗值 : 65277
威望值 : 12862
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i11.servimg.com/u/f11/19/71/67/71/2d3d10.png2D+3D線上 顧問外掛程式 經典問與答讀者 藍鵲1號
2009聚會勳章 2010聚會勳章 2011聚會勳章 2012聚會勳章 2013勳章-2D基礎 2014聚會勳章 2015聚會勳章 2016聚會勳章 串連貼紙成功 男 水瓶座 兔

http://mypaper.pchome.com.tw/kv1012tiger

回頂端 向下

回復: [討論]版筋搭接長度驗算LISP

發表 由 a258 于 2016-12-28, 01:36

讚讚讚我需要這個程式先下載試用再回報謝謝提供
avatar
a258
初級會員
初級會員

文章總數 : 37
年齡 : 50
來自 : 桃園
職業 :
愛好 : 電腦
個性 : 自由
使用年資 : 1
使用版本 : 2008
積分 : 2
經驗值 : 2870
威望值 : 18
注冊日期 : 2010-07-10
顧問外掛程式 經典問與答讀者 藍鵲551號
男 雙子座 羊

回頂端 向下

回復: [討論]版筋搭接長度驗算LISP

發表 由 a258 于 2016-12-28, 01:59

請問我的版筋列示格式如下
#3 635x39@15
應該如何修正程式才能抓到數據
謝謝
avatar
a258
初級會員
初級會員

文章總數 : 37
年齡 : 50
來自 : 桃園
職業 :
愛好 : 電腦
個性 : 自由
使用年資 : 1
使用版本 : 2008
積分 : 2
經驗值 : 2870
威望值 : 18
注冊日期 : 2010-07-10
顧問外掛程式 經典問與答讀者 藍鵲551號
男 雙子座 羊

回頂端 向下

回復: [討論]版筋搭接長度驗算LISP

發表 由 devinchou 于 2017-01-25, 14:13

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 )))
副程式是抓選取到的版筋長度...
過幾天就放假了...
我再把程式改成你需要我擺上來...
avatar
devinchou
初級會員
初級會員

文章總數 : 49
年齡 : 40
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 2
經驗值 : 1451
威望值 : 150
注冊日期 : 2015-02-15
男 天蝎座 蛇

回頂端 向下

回復: [討論]版筋搭接長度驗算LISP

發表 由 a258 于 2017-02-07, 01:56

[quote="devinchou"]
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)
avatar
a258
初級會員
初級會員

文章總數 : 37
年齡 : 50
來自 : 桃園
職業 :
愛好 : 電腦
個性 : 自由
使用年資 : 1
使用版本 : 2008
積分 : 2
經驗值 : 2870
威望值 : 18
注冊日期 : 2010-07-10
顧問外掛程式 經典問與答讀者 藍鵲551號
男 雙子座 羊

回頂端 向下

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


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