[討論]版筋搭接長度驗算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,
程式的使用上暫時沒問題,
只不過少了防呆功能!
請各位先進指教!
謝謝!
以下為使用說明影片...

謝謝您再次熱心分享～


有需要的朋友記得回文感謝！

讚讚讚我需要這個程式先下載試用再回報謝謝提供

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

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

[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)