自动计算钢筋总长总重

hai20110730 · 发表于 2020-8-31 17:01:47

本帖最后由 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 delimiter datastr "," ""))
(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 8 NIL NIL NIL) 表示按照8组码值（图层名称）进行排序，顺序为从小到大
|;
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
(setq LST '()
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 8 NIL NIL NIL) 表示按照8组码值（图层名称）进行排序，顺序为从小到大
|;
(defun SORT-ET (ENAMELST DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
(setq LST '()
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

；；；开发者：上善若水，引用请注明出处。 
(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 delimiter  datastr ","  "")) 
    (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 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大             
|; 
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP) 
  (setq  LST '() 
  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 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大             
|; 
(defun SORT-ET (ENAMELST DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP) 
  (setq  LST '() 
  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

cghdy · 发表于 2020-9-1 09:19:06

不错，装配式的图吧，这些数据不能通过yjk等计算软件导出吗

hai20110730 · 发表于 2020-9-1 16:30:42

cghdy 发表于 2020-9-1 09:19
不错，装配式的图吧，这些数据不能通过yjk等计算软件导出吗

这个钢筋表数据里所有数字都是纯的文本数字，没有扩展字符，不知道yjk是不是要通过扩展字符实现数据导出。

zhangcan0515 · 发表于 2020-9-19 14:49:57

厉害了！！学习一下

xmq1103 · 发表于 2020-10-6 22:13:27

厉害了！！学习一下

hl2006 · 发表于 2022-1-2 13:58:25

本帖最后由 hl2006 于 2022-1-2 14:10 编辑

你这个理论重量那地方能改下就好了，在理论重量的时候（如：0.00617*12*12保留三位小数）

rhww · 发表于 2024-1-27 11:23:39

报错

no function definition: SORT-SE

账号		自动登录	找回密码
密码			注册

[源码] 自动计算钢筋总长总重

本帖子中包含更多资源

浏览过的版块