设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 自动计算钢筋总长总重
返回列表 发新帖
查看: 1920|回复: 6

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

[复制链接]
hai20110730
发表于 2020-8-31 17:01:47 | 显示全部楼层 |阅读模式
本帖最后由 hai20110730 于 2020-8-31 17:05 编辑

  1. ；；；开发者：上善若水，引用请注明出处。
  2. (vl-load-com)
  3. ;;;形成矩阵
  4. (defun xcjz(xcjz_ss)
  5.   (setq xcjz_ss1 (SORT-SE xcjz_ss 10 1 0 T))
  6.   (setq xcjz_i 0 xcjz_enamelst nil)
  7.   (repeat (/ (sslength xcjz_ss1) 5)
  8.     (setq xcjz_enam1 (ssname xcjz_ss1 xcjz_i))
  9.     (setq xcjz_enam2 (ssname xcjz_ss1 (+ xcjz_i 1)))
  10.     (setq xcjz_enam3 (ssname xcjz_ss1 (+ xcjz_i 2)))
  11.     (setq xcjz_enam4 (ssname xcjz_ss1 (+ xcjz_i 3)))
  12.     (setq xcjz_enam5 (ssname xcjz_ss1 (+ xcjz_i 4)))
  13.     (setq xcjz_enamelst (cons (SORT-ET (list xcjz_enam1 xcjz_enam2 xcjz_enam3 xcjz_enam4 xcjz_enam5) 10 0 0 T) xcjz_enamelst))
  14.     (setq xcjz_i (+ xcjz_i 5))
  15.   )
  16.   (reverse xcjz_enamelst)
  17. )

  19. (defun C:GJJS()
  20.   (setq GJJS_lst (xcjz (ssget '((0 . "TEXT")))))
  21.   (setq GJJS_i 0)
  22.   (repeat (length GJJS_lst)
  23.     (setq GJJS_lstf (nth GJJS_i GJJS_lst))
  24.     (setq GJJS_enam1 (nth 0 GJJS_lstf))
  25.     (setq GJJS_enam2 (nth 1 GJJS_lstf))
  26.     (setq GJJS_enam3 (nth 2 GJJS_lstf))
  27.     (setq GJJS_enam4 (nth 3 GJJS_lstf))
  28.     (setq GJJS_enam5 (nth 4 GJJS_lstf))
  29.     (setq GJJS_ggent (entget GJJS_enam1) GJJS_gg (ggzh (cdr (assoc 1 GJJS_ggent))))
  30.     (setq GJJS_cdent (entget GJJS_enam2) GJJS_cd (cdzh (cdr (assoc 1 GJJS_cdent))))
  31.     (setq GJJS_gsent (entget GJJS_enam3) GJJS_gs (gszh (cdr (assoc 1 GJJS_gsent))))
  32.     (gjk GJJS_gg GJJS_cd GJJS_gs GJJS_enam4 GJJS_enam5)
  33.     (setq GJJS_i (1+ GJJS_i))
  34.   )
  35.   (prin1)
  36. )

  38. (defun gjk(gj_gg gj_cd gj_gs gj_zcname gj_zlname / )
  39.   (setq gj_zcname (entget gj_zcname))
  40.   (setq gj_zlname (entget gj_zlname))
  41.   (setq gj_zc (atof (cdr (assoc 1 gj_zcname))));_求钢筋总长
  42.   (setq gj_zl (atof (cdr (assoc 1 gj_zlname))));_求钢筋重量
  43.   (setq gj_zcnr (* gj_cd gj_gs))
  44.   (setq gj_zcnrf (rtos (/ (* gj_cd gj_gs) 1000.0) 2 2))
  45.   (setq gj_zlnr (rtos (/ (* (* 0.00617 (expt gj_gg 2.0)) gj_zcnr) 1000.0) 2 2))
  46.   (setq gj_zcnrf (cons 1 gj_zcnrf))
  47.   (setq gj_zlnr (cons 1 gj_zlnr))
  48.   (setq gj_zc (subst gj_zcnrf (assoc 1 gj_zcname) gj_zcname))
  49.   (setq gj_zl (subst gj_zlnr (assoc 1 gj_zlname) gj_zlname))
  50.   (entmod gj_zc)(entmod gj_zl)
  51.   (prin1)
  52. )

  54. ;;;(setq uu (xcjz (ssget '((0 . "TEXT")))))
  55. ;;;(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)))
  56. ;;;(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)))

  58. ;;;规格转换
  59. ;;;(setq ggzh_zfc "\U+008412")
  60. ;;;(setq ggzh_zfc "%%13112")
  61. (defun ggzh(ggzh_zfc)
  62.   (cond ((wcmatch ggzh_zfc "*%%*")
  63.       (setq ggzh_str (substr ggzh_zfc 6 (- (strlen ggzh_zfc) 5))))
  64.   ((wcmatch (substr ggzh_zfc 1 1) "\\")
  65.       (setq ggzh_str (substr ggzh_zfc 8 (- (strlen ggzh_zfc) 7))))
  66.       (T (setq ggzh_str ggzh_zfc))
  67.   )
  68.   (atof ggzh_str)
  69. )
  70. ;;;(ggzh ggzh_zfc)


  73. ;;;长度转换
  74. ;;;(setq cdzh_zfc "2830")
  75. (defun cdzh(cdzh_zfc)
  76.   (if (wcmatch cdzh_zfc "*~*")
  77.           (setq cdzh_strlst (Parse cdzh_zfc "~"))
  78.         )
  79.   (if (wcmatch cdzh_zfc "*～*")
  80.           (setq cdzh_strlst (Parse cdzh_zfc "～"))
  81.         )
  82.   (if (or (wcmatch cdzh_zfc "*~*") (wcmatch cdzh_zfc "*～*"))
  83.       (setq cdzh_real (* 0.5 (+ (atof (car cdzh_strlst))(atof (cadr cdzh_strlst)))))
  84.       (setq cdzh_real (atof cdzh_zfc))
  85.   )
  86. )
  87. ;;;(cdzh "2100～3900")


  90. ;;;根数转换
  91. (defun gszh(gszh_zfc)
  92.   (if (not c:cal) (arxload "geomcal"))
  93.   (if (wcmatch gszh_zfc "*（*")
  94.           (setq gszh_zfc (XD::String:Replace "（" gszh_zfc "(" ""))
  95.         )
  96.   (if (wcmatch gszh_zfc "*）*")
  97.           (setq gszh_zfc (XD::String:Replace "）" gszh_zfc ")" ""))
  98.         )
  99.   (if (wcmatch gszh_zfc "*×*")
  100.           (setq gszh_zfc (XD::String:Replace "×"  gszh_zfc "*" ""))
  101.         )
  102.   (cal gszh_zfc)
  103. )
  104. ;;;(gszh "(6+3)+2")


  107. ;;[功能] 字符串查找与替换(正则表达式)
  108. (defun XD::String:Replace (pat str nstr key / end)
  109.   (if (not *xxvbsexp)
  110.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
  111.   )
  112.   (vlax-put *xxvbsexp 'Pattern pat)
  113.   (if (not key)
  114.     (setq key "")
  115.   )
  116.   (setq key (strcase key))
  117.   (setq keys '(("I" "IgnoreCase") ("G" "Global") ("M" "Multiline")))
  118.   (mapcar '(lambda (x)
  119.        (if (wcmatch key (strcat "*" (car x) "*"))
  120.          (vlax-put *xxvbsexp (read (cadr x)) 0)
  121.          (vlax-put *xxvbsexp (read (cadr x)) -1)
  122.        )
  123.      )
  124.     keys
  125.   )
  126.   (vlax-invoke *xxvbsexp 'replace str nstr)
  127. )
  128. ;;;(XD::String:Replace "×"  "(6+3)××2" "*"  "")
  129. ;;;(XD::String:Replace "～"  "2100～3900" ","  "")
  130. ;;;(setq delim "2100～3900" str "～")
  131. ;;;(defun Parse (str delim /
  132. ;;;        lst pos
  133. ;;;        )
  134. ;;;  (setq pos (zg-string-search delim str 0))
  135. ;;;    (setq lst (cons (substr str 1 pos) lst)
  136. ;;;    str (substr str (+ pos 2))
  137. ;;;    pos (vl-string-search delim str)
  138. ;;;    )
  139. ;;;  (if (> (strlen str) 0)
  140. ;;;    (setq lst (cons str lst))
  141. ;;;  )
  142. ;;;  (if (= " " delim)
  143. ;;;    (setq lst (vl-remove "" lst))
  144. ;;;  )
  145. ;;;  (reverse lst)
  146. ;;;)

  148. ; user defined function strsplit.
  149. ; strsplit splits a string with delimiter, and return a list.
  150. ; example: (strsplit "1,22,333,4444" ",")    -->> ("1","22","333","4444")
  151. ;          (strsplit ",1,22,333,4444," ",")  -->> ("" "1" "22" "333" "4444" "")
  152. (defun strsplit(datastr delimiter)
  153.     (setq strlist '()
  154.           str ""
  155.     )
  156.     (setq n (strlen datastr))
  157.     (setq i 1)
  158.     (repeat n
  159.         ; s is a single letter, starts from the first to the end.
  160.         (setq s (substr datastr i 1))
  161.         ;
  162.         (if (/= s delimiter)
  163.             ; when s is't a delimiter
  164.             (progn
  165.                 (setq str (strcat str s))
  166.                 ; if s is the last letter
  167.                 (if (= i n)
  168.                     (setq strlist (cons str strlist))
  169.                 )
  170.             )
  171.             ; when s is a delimiter
  172.             (progn
  173.                 (setq strlist (cons str strlist))
  174.                 (setq str "")
  175.                 ; if delimiter is the last letter
  176.                 (if (= i n)
  177.                     (setq strlist (cons "" strlist))
  178.                 )
  179.             )
  180.         )
  181.         (setq i (1+ i))
  182.     )
  183.     ; reverse list and retrun it
  184.     (reverse strlist)
  185. )

  187. (defun Parse(datastr delimiter)  
  188.     (setq datastr (XD::String:Replace delimiter  datastr ","  ""))
  189.     (strsplit datastr ",")
  190. )

  192. ;;;(Parse "2100～3900" "～")



  196. ;|;;参数说明：SE  ----要排序的选择集                                                                  
  197.               DXF ----排序依据的组码号                                                                 
  198.               INT ----如果组码值为一个表，则INT指出使用第几个；否则nil                                 
  199.               FUZZ----允许偏差；若无为nil                                                              
  200.               K   ----T表示从大到小，nil表示从小到大                                                   
  201.     返回值：排序后的选择集                                                                             
  202.     示例：(SORT-SE SS 10 0   5.0 T  )  表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
  203.           (SORT-SE SS 10 1   3.0 NIL)  表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
  204.           (SORT-SE SS 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大            
  205. |;
  206. (defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
  207.   (setq  LST '()
  208.   INDEX 0
  209.   )
  210.   (repeat (sslength SE)
  211.     (setq ENT (entget (ssname SE INDEX))
  212.     TMP (cdr (assoc DXF ENT))
  213.     )
  214.     (if  (and INT
  215.        (= (type INT) 'INT)
  216.        (= (type TMP) 'list)
  217.        (< INT (length TMP))
  218.   )
  219.       (setq TMP (nth INT TMP))
  220.     )
  221.     (setq LST (cons (list TMP (cdr (assoc 5 ENT))) LST))
  222.     (setq INDEX (1+ INDEX))
  223.   ) ;_建立排序列表
  224.   (if (and FUZZ
  225.      (or (= (type FUZZ) 'INT) (= (type FUZZ) 'REAL))
  226.      (or (= (type TMP) 'INT) (= (type TMP) 'REAL))
  227.       )
  228.     (setq NEWLST
  229.      (vl-sort
  230.        LST
  231.        (function (lambda (E1 E2) (< (+ (car E1) FUZZ) (car E2)))
  232.        )
  233.      )
  234.     )
  235.     (setq NEWLST
  236.      (vl-sort LST
  237.         (function (lambda (E1 E2) (< (car E1) (car E2))))
  238.      )
  239.     )
  240.   ) ;_排序操作
  241.   (if K
  242.     (setq NEWLST (reverse NEWLST))
  243.   ) ;_如果K为T，则倒置
  244.   (setq NEWSE (ssadd)) ;_组织排序后的选择集
  245.   (foreach TMP NEWLST
  246.     (setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
  247.   )
  248.   NEWSE ;_返回值
  249. ) ;_结束defun


  252. ;|;;参数说明：ENAMELST  ----要排序的图元列表                                                           
  253.               DXF ----排序依据的组码号                                                                 
  254.               INT ----如果组码值为一个表，则INT指出使用第几个；否则nil                                 
  255.               FUZZ----允许偏差；若无为nil                                                              
  256.               K   ----T表示从大到小，nil表示从小到大                                                   
  257.     返回值：排序后的选择集                                                                             
  258.     示例：(SORT-SE SS 10 0   5.0 T  )  表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
  259.           (SORT-SE SS 10 1   3.0 NIL)  表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
  260.           (SORT-SE SS 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大            
  261. |;
  262. (defun SORT-ET (ENAMELST DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
  263.   (setq  LST '()
  264.   INDEX 0
  265.   )
  266.   (repeat (length ENAMELST)
  267.     (setq ENT (entget (nth INDEX ENAMELST))
  268.     TMP (cdr (assoc DXF ENT))
  269.     )
  270.     (if  (and INT
  271.        (= (type INT) 'INT)
  272.        (= (type TMP) 'list)
  273.        (< INT (length TMP))
  274.   )
  275.       (setq TMP (nth INT TMP))
  276.     )
  277.     (setq LST (cons (list TMP (cdr (assoc 5 ENT))) LST))
  278.     (setq INDEX (1+ INDEX))
  279.   ) ;_建立排序列表
  280.   (if (and FUZZ
  281.      (or (= (type FUZZ) 'INT) (= (type FUZZ) 'REAL))
  282.      (or (= (type TMP) 'INT) (= (type TMP) 'REAL))
  283.       )
  284.     (setq NEWLST
  285.      (vl-sort
  286.        LST
  287.        (function (lambda (E1 E2) (< (+ (car E1) FUZZ) (car E2)))
  288.        )
  289.      )
  290.     )
  291.     (setq NEWLST
  292.      (vl-sort LST
  293.         (function (lambda (E1 E2) (< (car E1) (car E2))))
  294.      )
  295.     )
  296.   ) ;_排序操作
  297.   (if K
  298.     (setq NEWLST (reverse NEWLST))
  299.   ) ;_如果K为T，则倒置
  300.   (setq NEWSE nil) ;_组织排序后的选择集
  301.   (foreach TMP NEWLST
  302.     (setq NEWSE (cons (handent (cadr TMP)) NEWSE))
  303.   )
  304.   NEWSE ;_返回值
  305. ) ;_结束defun



本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复

使用道具 举报

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
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-25 23:45 , Processed in 0.199945 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表