[討論]分享檢料輔助小軟體：配筋-長度替換(LISP)

;　本程式為配筋長度替換輔助小工具(B_REBAR變更為A_REBAR)
　;　支援軟體版本("AutoCAD")
　;　設計者：Devin,Chou
　;　版權所有，歡迎使用
　;　Rev.2(2014/12/14)
　;　進版說明： -.程式碼精簡

代碼:

(defun C:rls (/ ra ra_1 ra_s1 ra_s2 ra_s3 ra_L
               rb rb_d rb_1 rb_s1 rb_s2 rb_s3 rb_L
               n_r )
(setvar "cmdecho" 0 )
(setq ra (entsel "\n選取配筋長度(來源):" ))
(setq ra_1
   (cdr
   (assoc 1
   (entget (car ra
   )))))
(setq ra_s1
   (1+
   (vl-string-search "-" ra_1
   )))
(setq ra_s2
   (vl-string-search "=" ra_1
   ))
(setq ra_s3
   (- ra_s2 ra_s1
   ))
(setq ra_L
   (substr ra_1
   (1+ ra_s1 ) ra_s3
   ))
(while
(setq rb (entsel "\n選取配筋長度(變更):" ))
(setq rb_d (entget (car rb )))
(setq rb_1
   (cdr
   (assoc 1 rb_d
   )))
(setq rb_s1
   (1+
   (vl-string-search "-" rb_1
   )))
(setq rb_s2
   (vl-string-search "=" rb_1
   ))
(setq rb_s3
   (- rb_s2 rb_s1
   ))
(setq rb_L
   (substr rb_1
   (1+ rb_s1 ) rb_s3
   ))
(setq n_r
   (cons 1
   (vl-string-subst ra_L rb_L rb_1
   )))
(setq rb_d
   (subst n_r
   (cons 1 rb_1 ) rb_d
   ))
(entmod rb_d )
) ; while
(prin1)
) ; end
(princ "\nC:rls(2版)")
(prin1)


例:A配筋 #4-500=52
   B1配筋 #4-600=32 B2配筋 #4-450=22 B3配筋 #4-784=99 ...
先選A配筋,再選B1.B2.B3...(可重覆選取要替換的配筋長度)
B1.B2.B3配筋長度會自動變更為A配筋的長度...

這LISP是小弟為了工作上的需求所寫的...
希望有興趣的朋友能夠提供使用上的意見...
謝謝大家!!!^_^

2016.11.22

使用步驟說明影片檔來了...

謝謝你的分享~
非建築相關~所以不知道怎麼使用

judyyai 寫到:謝謝你的分享~
非建築相關~所以不知道怎麼使用

我也是不知如何使用～
還是謝謝您無私分享！
有用到的朋友可以補圖教一下嘛～

Tiger&蘋果爸 寫到:

judyyai 寫到:謝謝你的分享~
非建築相關~所以不知道怎麼使用

我也是不知如何使用～
還是謝謝您無私分享！
有用到的朋友可以補圖教一下嘛～

謝謝蘋果爸的版面編排...

我有時間會把使用步驟...
截圖上傳的...


這個lisp的原理等同於蘋果爸的圖塊置換lisp...
不過置換的是文字...
就是針對[#4(鋼筋號數)-500(鋼筋長度)=50(鋼筋支數)]鋼筋長度做替換...
是我為了節省作業時間寫的...
發表上來是想要拋磚引玉...
也請各位前輩指導我lisp語法不足的地方...
謝謝...

好用，減少計算時間。廠商報價檢核時也會很便利。

使用說明來了~~~

1.版配筋原始資料


2.使用文字編輯功能將配筋變更為所需長度


3.選取已變更的配筋


4.接著選取要變更的配筋


5.配筋長度已替換完成
 (可連續選取要替換的配筋)

感謝大大的無私分享,讓我們增加許多的工作效率

大大看你的使用說明,發現原版資料裡的資料
有#3-484=28,#3-485=25
這因該是用LISP跑出來的
為何不直接進位到整數
我也是同業,很難遇到同業的

小弟是新手主任~謝謝分享~我會努力熟悉使用~好可以加快我計算的能力

這裡真是個好地方
一下子就找到好多lisp
先下載試用試用
謝謝無私分享

潛水中...
偶而也要浮出水面來換氣...

長度替換修訂版:
增加單選及多選功能,
程式碼如下...

代碼:

　;　REBAR OF LENGTH T0 SUBSTITUTE(A-REBAR TO SUBSTITUTE FOR B-REBAR)
　;　本程式為配筋長度替換輔助小工具(B_REBAR變更為A_REBAR)
　;　支援軟體版本("AutoCAD")
　;　設計者：Devin,Chou
　;　版權所有，歡迎使用
　;　Rev.3(2015/10/26)
　;　進版說明： 1.判斷式.單選(S)/多選(M) 2.圖元過濾.配筋格式
(defun C:rls (/ s_in r_in con_X lc_a lc_b
               ra ra_d ra_z ra_1 ra_s1 ra_s2 ra_s3 ra_L
               rb rb_d rb_z rb_1 rb_s1 rb_s2 rb_s3 rb_L
               s_rb s_rb_d s_rb_1 s_rb_s1 s_rb_s2 s_rb_s3 s_rb_L
               n_r s_n_r )
(setvar "cmdecho" 0 )
(setq s_in 0 )
(setq r_in 0 )
(initget "S M" )
(setq con_X
   (getkword
   (strcat "\n配筋長度替換[單選(S)/多選(M)]<S>:" )))
(if (= con_X nil )
   (setq con_X "S" )
) ; if
(setq ra (entsel "\n選取配筋長度(來源):" ))
(setq lc_a 0 )
(while (= lc_a 0 )
(if (= ra nil )
(setq ra (entsel "\n重新選取配筋長度(來源):" ))
) ; if
(setq ra_d
   (entget (car ra )))
(setq ra_z
   (cdr (assoc 0 ra_d )))
(setq ra_1
   (cdr (assoc 1 ra_d )))
(if (and (= ra_z "TEXT")
        (wcmatch ra_1 "*`##*-#*=#*" ))
(setq lc_a 1 )
(progn
(alert (strcat "非配筋格式，請重新選取" ))
(setq ra '() )
(setq lc_a 0 )
) ; progn
) ; if
) ; while
(setq ra_s1
   (1+ (vl-string-search "-" ra_1 )))
(setq ra_s2
   (vl-string-search "=" ra_1 ))
(setq ra_s3
   (- ra_s2 ra_s1 ))
(setq ra_L
   (substr ra_1 (1+ ra_s1 ) ra_s3 ))
(cond
((= con_X "S" )
(progn
(while
(setq rb (entsel "\n選取配筋長度(變更):" ))
(setq lc_b 0 )
(while (= lc_b 0 )
(if (= rb nil )
(setq rb (entsel "\n重新選取配筋長度(變更):" ))
) ; if
(setq rb_d
   (entget (car rb )))
(setq rb_z
   (cdr (assoc 0 rb_d )))
(setq rb_1
   (cdr (assoc 1 rb_d )))
(if (and (= rb_z "TEXT")
        (wcmatch rb_1 "*`##*-#*=#*" ))
(setq lc_b 1 )
(progn
(alert (strcat "非配筋格式，請重新選取" ))
(setq rb '() )
(setq lc_b 0 )
) ; progn
) ; if
) ; while
(setq rb_s1
   (1+ (vl-string-search "-" rb_1 )))
(setq rb_s2
   (vl-string-search "=" rb_1 ))
(setq rb_s3
   (- rb_s2 rb_s1 ))
(setq rb_L
   (substr rb_1 (1+ rb_s1 ) rb_s3 ))
(setq n_r
   (cons 1 (vl-string-subst ra_L rb_L rb_1 )))
(setq rb_d
   (subst n_r (cons 1 rb_1 ) rb_d ))
(entmod rb_d )
) ; while
) ; progn
) ; (= con_X "S" ),end
((= con_X "M" )
(progn
(princ "\n選取配筋長度(變更):" )
(setq s_rb (ssget '((0 . "TEXT"))))
(repeat (sslength s_rb )
(setq s_rb_d
   (entget (ssname s_rb s_in )))
(setq s_rb_1
   (cdr (assoc 1 s_rb_d )))
(if (wcmatch s_rb_1 "*`##*-#*=#*" )
(progn
(setq s_rb_s1
   (1+ (vl-string-search "-" s_rb_1 )))
(setq s_rb_s2
   (vl-string-search "=" s_rb_1 ))
(setq s_rb_s3
   (- s_rb_s2 s_rb_s1 ))
(setq s_rb_L
   (substr s_rb_1 (1+ s_rb_s1 ) s_rb_s3 ))
(setq s_n_r
   (cons 1 (vl-string-subst ra_L s_rb_L s_rb_1 )))
(setq s_rb_d
   (subst s_n_r (cons 1 s_rb_1 ) s_rb_d ))
(entmod s_rb_d )
(setq r_in (1+ r_in ))
) ; progn
) ; if
(setq s_in (1+ s_in ))
) ; repeat
(alert (strcat "替換個數：" (itoa r_in ) "個" ))
) ; progn
) ; (= con_X "M" ),end
) ; cond
(prin1)
) ; end
(princ "\nC:rls(3版)")
(prin1)

chien_yi 寫到:大大看你的使用說明,發現原版資料裡的資料
有#3-484=28,#3-485=25
這因該是用LISP跑出來的
為何不直接進位到整數
我也是同業,很難遇到同業的

被發現了...
這確實是軟體跑出來的沒錯...
這軟體本身是可以把配筋資料進位到整數...
但...是以10進位為倍數...
為了現場施工及找料方便...
所以在作業時...
我都會把版筋調成30倍數...

建議 設成自由倍數 ,在依各工地的需求自動跑出需求的倍數長度就不用在修改

chien_yi 寫到:建議 設成自由倍數 ,在依各工地的需求自動跑出需求的倍數長度就不用在修改

能改的話...
我也想改呀!
但小弟所在的公司...
用的檢料軟體是跟別人買的...
所以在軟體的限制下...
我就只能自己寫些輔助用的小程式了...

原來是這樣
我是用自己寫的一些無法拿到檯面上的小工具
但是可以應付所有的美式版筋

多謝devinchou大大提供LISP語法及操作說明，感謝您的付出

痾...完全進不了狀況
還是感謝大大分享！

使用步驟說明影片檔來了...

devinchou 寫到:
使用步驟說明影片檔來了...

謝謝你辛苦錄製影片教學!