自动计算钢筋总长总重
本帖最后由 hai20110730 于 2020-8-31 17:05 编辑；；；开发者：上善若水，引用请注明出处。
(vl-load-com)
;;;形成矩阵
(defun xcjz(xcjz_ss)
(setq xcjz_ss1 (SORT-SE xcjz_ss 10 1 0 T))
(setq xcjz_i 0 xcjz_enamelst nil)
(repeat (/ (sslength xcjz_ss1) 5)
(setq xcjz_enam1 (ssname xcjz_ss1 xcjz_i))
(setq xcjz_enam2 (ssname xcjz_ss1 (+ xcjz_i 1)))
(setq xcjz_enam3 (ssname xcjz_ss1 (+ xcjz_i 2)))
(setq xcjz_enam4 (ssname xcjz_ss1 (+ xcjz_i 3)))
(setq xcjz_enam5 (ssname xcjz_ss1 (+ xcjz_i 4)))
(setq xcjz_enamelst (cons (SORT-ET (list xcjz_enam1 xcjz_enam2 xcjz_enam3 xcjz_enam4 xcjz_enam5) 10 0 0 T) xcjz_enamelst))
(setq xcjz_i (+ xcjz_i 5))
)
(reverse xcjz_enamelst)
)
(defun C:GJJS()
(setq GJJS_lst (xcjz (ssget '((0 . "TEXT")))))
(setq GJJS_i 0)
(repeat (length GJJS_lst)
(setq GJJS_lstf (nth GJJS_i GJJS_lst))
(setq GJJS_enam1 (nth 0 GJJS_lstf))
(setq GJJS_enam2 (nth 1 GJJS_lstf))
(setq GJJS_enam3 (nth 2 GJJS_lstf))
(setq GJJS_enam4 (nth 3 GJJS_lstf))
(setq GJJS_enam5 (nth 4 GJJS_lstf))
(setq GJJS_ggent (entget GJJS_enam1) GJJS_gg (ggzh (cdr (assoc 1 GJJS_ggent))))
(setq GJJS_cdent (entget GJJS_enam2) GJJS_cd (cdzh (cdr (assoc 1 GJJS_cdent))))
(setq GJJS_gsent (entget GJJS_enam3) GJJS_gs (gszh (cdr (assoc 1 GJJS_gsent))))
(gjk GJJS_gg GJJS_cd GJJS_gs GJJS_enam4 GJJS_enam5)
(setq GJJS_i (1+ GJJS_i))
)
(prin1)
)
(defun gjk(gj_gg gj_cd gj_gs gj_zcname gj_zlname / )
(setq gj_zcname (entget gj_zcname))
(setq gj_zlname (entget gj_zlname))
(setq gj_zc (atof (cdr (assoc 1 gj_zcname))));_求钢筋总长
(setq gj_zl (atof (cdr (assoc 1 gj_zlname))));_求钢筋重量
(setq gj_zcnr (* gj_cd gj_gs))
(setq gj_zcnrf (rtos (/ (* gj_cd gj_gs) 1000.0) 2 2))
(setq gj_zlnr (rtos (/ (* (* 0.00617 (expt gj_gg 2.0)) gj_zcnr) 1000.0) 2 2))
(setq gj_zcnrf (cons 1 gj_zcnrf))
(setq gj_zlnr (cons 1 gj_zlnr))
(setq gj_zc (subst gj_zcnrf (assoc 1 gj_zcname) gj_zcname))
(setq gj_zl (subst gj_zlnr (assoc 1 gj_zlname) gj_zlname))
(entmod gj_zc)(entmod gj_zl)
(prin1)
)
;;;(setq uu (xcjz (ssget '((0 . "TEXT")))))
;;;(entdel (nth 0 (nth 0 uu)))(entdel (nth 1 (nth 0 uu)))(entdel (nth 2 (nth 0 uu)))(entdel (nth 3 (nth 0 uu)))(entdel (nth 4 (nth 0 uu)))
;;;(entdel (nth 0 (nth 1 uu)))(entdel (nth 1 (nth 1 uu)))(entdel (nth 2 (nth 1 uu)))(entdel (nth 3 (nth 1 uu)))(entdel (nth 4 (nth 1 uu)))
;;;规格转换
;;;(setq ggzh_zfc "\U+008412")
;;;(setq ggzh_zfc "%%13112")
(defun ggzh(ggzh_zfc)
(cond ((wcmatch ggzh_zfc "*%%*")
(setq ggzh_str (substr ggzh_zfc 6 (- (strlen ggzh_zfc) 5))))
((wcmatch (substr ggzh_zfc 1 1) "\\")
(setq ggzh_str (substr ggzh_zfc 8 (- (strlen ggzh_zfc) 7))))
(T (setq ggzh_str ggzh_zfc))
)
(atof ggzh_str)
)
;;;(ggzh ggzh_zfc)
;;;长度转换
;;;(setq cdzh_zfc "2830")
(defun cdzh(cdzh_zfc)
(if (wcmatch cdzh_zfc "*~*")
(setq cdzh_strlst (Parse cdzh_zfc "~"))
)
(if (wcmatch cdzh_zfc "*～*")
(setq cdzh_strlst (Parse cdzh_zfc "～"))
)
(if (or (wcmatch cdzh_zfc "*~*") (wcmatch cdzh_zfc "*～*"))
(setq cdzh_real (* 0.5 (+ (atof (car cdzh_strlst))(atof (cadr cdzh_strlst)))))
(setq cdzh_real (atof cdzh_zfc))
)
)
;;;(cdzh "2100～3900")
;;;根数转换
(defun gszh(gszh_zfc)
(if (not c:cal) (arxload "geomcal"))
(if (wcmatch gszh_zfc "*（*")
(setq gszh_zfc (XD::String:Replace "（" gszh_zfc "(" ""))
)
(if (wcmatch gszh_zfc "*）*")
(setq gszh_zfc (XD::String:Replace "）" gszh_zfc ")" ""))
)
(if (wcmatch gszh_zfc "*×*")
(setq gszh_zfc (XD::String:Replace "×"gszh_zfc "*" ""))
)
(cal gszh_zfc)
)
;;;(gszh "(6+3)+2")
;;[功能] 字符串查找与替换(正则表达式)
(defun XD::String:Replace (pat str nstr key / end)
(if (not *xxvbsexp)
(setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
)
(vlax-put *xxvbsexp 'Pattern pat)
(if (not key)
(setq key "")
)
(setq key (strcase key))
(setq keys '(("I" "IgnoreCase") ("G" "Global") ("M" "Multiline")))
(mapcar '(lambda (x)
(if (wcmatch key (strcat "*" (car x) "*"))
(vlax-put *xxvbsexp (read (cadr x)) 0)
(vlax-put *xxvbsexp (read (cadr x)) -1)
)
)
keys
)
(vlax-invoke *xxvbsexp 'replace str nstr)
)
;;;(XD::String:Replace "×""(6+3)××2" "*""")
;;;(XD::String:Replace "～""2100～3900" ",""")
;;;(setq delim "2100～3900" str "～")
;;;(defun Parse (str delim /
;;; lst pos
;;; )
;;;(setq pos (zg-string-search delim str 0))
;;; (setq lst (cons (substr str 1 pos) lst)
;;; str (substr str (+ pos 2))
;;; pos (vl-string-search delim str)
;;; )
;;;(if (> (strlen str) 0)
;;; (setq lst (cons str lst))
;;;)
;;;(if (= " " delim)
;;; (setq lst (vl-remove "" lst))
;;;)
;;;(reverse lst)
;;;)
; user defined function strsplit.
; strsplit splits a string with delimiter, and return a list.
; example: (strsplit "1,22,333,4444" ",") -->> ("1","22","333","4444")
; (strsplit ",1,22,333,4444," ",")-->> ("" "1" "22" "333" "4444" "")
(defun strsplit(datastr delimiter)
(setq strlist '()
str ""
)
(setq n (strlen datastr))
(setq i 1)
(repeat n
; s is a single letter, starts from the first to the end.
(setq s (substr datastr i 1))
;
(if (/= s delimiter)
; when s is't a delimiter
(progn
(setq str (strcat str s))
; if s is the last letter
(if (= i n)
(setq strlist (cons str strlist))
)
)
; when s is a delimiter
(progn
(setq strlist (cons str strlist))
(setq str "")
; if delimiter is the last letter
(if (= i n)
(setq strlist (cons "" strlist))
)
)
)
(setq i (1+ i))
)
; reverse list and retrun it
(reverse strlist)
)
(defun Parse(datastr delimiter)
(setq datastr (XD::String:Replace delimiterdatastr ","""))
(strsplit datastr ",")
)
;;;(Parse "2100～3900" "～")
;|;;参数说明：SE----要排序的选择集
DXF ----排序依据的组码号
INT ----如果组码值为一个表，则INT指出使用第几个；否则nil
FUZZ----允许偏差；若无为nil
K ----T表示从大到小，nil表示从小到大
返回值：排序后的选择集
示例：(SORT-SE SS 10 0 5.0 T)表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
(SORT-SE SS 10 1 3.0 NIL)表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
(SORT-SE SS 8NIL NIL NIL)表示按照8组码值（图层名称）进行排序，顺序为从小到大
|;
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
(setqLST '()
INDEX 0
)
(repeat (sslength SE)
(setq ENT (entget (ssname SE INDEX))
TMP (cdr (assoc DXF ENT))
)
(if(and INT
(= (type INT) 'INT)
(= (type TMP) 'list)
(< INT (length TMP))
)
(setq TMP (nth INT TMP))
)
(setq LST (cons (list TMP (cdr (assoc 5 ENT))) LST))
(setq INDEX (1+ INDEX))
) ;_建立排序列表
(if (and FUZZ
(or (= (type FUZZ) 'INT) (= (type FUZZ) 'REAL))
(or (= (type TMP) 'INT) (= (type TMP) 'REAL))
)
(setq NEWLST
(vl-sort
LST
(function (lambda (E1 E2) (< (+ (car E1) FUZZ) (car E2)))
)
)
)
(setq NEWLST
(vl-sort LST
(function (lambda (E1 E2) (< (car E1) (car E2))))
)
)
) ;_排序操作
(if K
(setq NEWLST (reverse NEWLST))
) ;_如果K为T，则倒置
(setq NEWSE (ssadd)) ;_组织排序后的选择集
(foreach TMP NEWLST
(setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
)
NEWSE ;_返回值
) ;_结束defun
;|;;参数说明：ENAMELST----要排序的图元列表
DXF ----排序依据的组码号
INT ----如果组码值为一个表，则INT指出使用第几个；否则nil
FUZZ----允许偏差；若无为nil
K ----T表示从大到小，nil表示从小到大
返回值：排序后的选择集
示例：(SORT-SE SS 10 0 5.0 T)表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
(SORT-SE SS 10 1 3.0 NIL)表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
(SORT-SE SS 8NIL NIL NIL)表示按照8组码值（图层名称）进行排序，顺序为从小到大
|;
(defun SORT-ET (ENAMELST DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
(setqLST '()
INDEX 0
)
(repeat (length ENAMELST)
(setq ENT (entget (nth INDEX ENAMELST))
TMP (cdr (assoc DXF ENT))
)
(if(and INT
(= (type INT) 'INT)
(= (type TMP) 'list)
(< INT (length TMP))
)
(setq TMP (nth INT TMP))
)
(setq LST (cons (list TMP (cdr (assoc 5 ENT))) LST))
(setq INDEX (1+ INDEX))
) ;_建立排序列表
(if (and FUZZ
(or (= (type FUZZ) 'INT) (= (type FUZZ) 'REAL))
(or (= (type TMP) 'INT) (= (type TMP) 'REAL))
)
(setq NEWLST
(vl-sort
LST
(function (lambda (E1 E2) (< (+ (car E1) FUZZ) (car E2)))
)
)
)
(setq NEWLST
(vl-sort LST
(function (lambda (E1 E2) (< (car E1) (car E2))))
)
)
) ;_排序操作
(if K
(setq NEWLST (reverse NEWLST))
) ;_如果K为T，则倒置
(setq NEWSE nil) ;_组织排序后的选择集
(foreach TMP NEWLST
(setq NEWSE (cons (handent (cadr TMP)) NEWSE))
)
NEWSE ;_返回值
) ;_结束defun
不错，装配式的图吧，这些数据不能通过yjk等计算软件导出吗 cghdy 发表于 2020-9-1 09:19
不错，装配式的图吧，这些数据不能通过yjk等计算软件导出吗
这个钢筋表数据里所有数字都是纯的文本数字，没有扩展字符，不知道yjk是不是要通过扩展字符实现数据导出。 厉害了！！学习一下
厉害了！！学习一下 本帖最后由 hl2006 于 2022-1-2 14:10 编辑
你这个理论重量那地方能改下就好了，在理论重量的时候（如：0.00617*12*12保留三位小数） 报错
no function definition: SORT-SE
页:
[1]