;;;  小萝卜头原创
;;;  http://e.ys168.com/?carrot1983
;;;  板系列 R1 删除小于某值的数字 R2 板筋长度数字取整  R3 几分几值 R4 板钢筋伸缩
;;;  梁系列 T1 一二级框架梁通长筋计算 T3 选择计算面积大于某个值 T4 显梁超筋配筋率 
;;;  T5 梁配筋根数计算 T6 梁支座筋计算 
;;;  L1 主梁四肢箍 L2 次梁二肢箍L3 主梁纵筋 L4 次梁纵筋 B1 板配筋


(defun JW-ENTMAKE-STYLE (STYLENAME FONTFILE BIGFONTFILE WIDTH / ELIST)
  (setq ELIST (list (cons 0 "STYLE")
      (cons 100 "AcDbSymbolTableRecord")
      (cons 100 "AcDbTextStyleTableRecord")
      (cons 2 STYLENAME) ;_style name
      (cons 70 0)
      (cons 40 0.0) ;_Height
      (cons 41 WIDTH)
      (cons 50 0.0)
      (cons 71 0)
      (cons 42 300.) ;_LastHeight
      (cons 3 FONTFILE)
       )
  )
  (if (/= BIGFONTFILE "")
    (setq ELIST (append ELIST (list (cons 4 BIGFONTFILE))))
  )
  (entmake ELIST)
)

 

(defun JW-SS->ENAMES (SS / ENAMES)
  (setq I 0)
  (while (< I (sslength SS))
    (setq ENAMES (cons (ssname SS I) ENAMES))
    (setq I (1+ I))
  )
  (reverse ENAMES)
)

 

(defun JW-ENTMAKE-LAYER (LAYERNAME LAYERCOLOR / ELIST)
  (setq ELIST (list (cons 0 "LAYER")
      (cons 100 "AcDbSymbolTableRecord")
      (cons 100 "AcDbLayerTableRecord")
      (cons 2 LAYERNAME)
      (cons 62 LAYERCOLOR)
      (cons 6 "Continuous")
      (cons 70 0)
       )
  )
  (entmake ELIST)
)

(defun JW-DXF (ENAME ITEM)
  (cdr (assoc ITEM (entget ENAME)))
)

(defun JW-DXF-SUBST (ITEM VALUE ELIST)
  (subst (cons ITEM VALUE) (assoc ITEM ELIST) ELIST)
)

(defun JW-STRING-SPLIT (STR    DELIMITER  /   LENSTR
   LENDELIMITER       START@  LSTSTR
   DONE    FIND@
         )
  (setq LENSTR      (strlen STR)
 LENDELIMITER (strlen DELIMITER)
 START@      0
 LSTSTR      NIL
 DONE      NIL
  )
  (while (and (not DONE) (<= (1+ START@) LENSTR))
    (if (setq FIND@ (vl-string-search DELIMITER STR START@))
      (setq LSTSTR (cons (if (zerop FIND@)
      ""
      (substr STR (1+ START@) (- FIND@ START@))
    )
    LSTSTR
     )
     START@ (+ FIND@ LENDELIMITER)
      )
      (setq DONE   t
     LSTSTR (cons (substr STR (1+ START@)) LSTSTR)
      )
    )
  )
  (if (= START@ LENSTR)
    (setq LSTSTR (cons "" LSTSTR))
  )
  (reverse LSTSTR)
)


;;;距离
(if (null *JWD)
  (setq *JWD 25)
)
(defun C:SETD (/ JWD)
  (if (null *JWD)
    (setq JWD 25)
    (setq JWD *JWD)
  )
  (setq *JWD (JW-GETDIST NIL "\n指定当前默认距离" JWD))
)

;;;整数
(if (null *JWI)
  (setq *JWI 25)
)
(defun C:SETI (/ JWI)
  (if (null *JWI)
    (setq JWI 25)
    (setq JWI *JWI)
  )
  (setq *JWI (JW-GETINT "\n指定当前默认整数" JWI))
)

;;;实数
(if (null *JWR)
  (setq *JWR 25.000)
)
(defun C:SETR (/ JWR)
  (if (null *JWR)
    (setq JWR 25.000)
    (setq JWR *JWR)
  )
  (setq *JWR (JW-GETREAL "\n指定当前默认实数" JWR 3))
)


;;;字符串
(if (null *JWS)
  (setq *JWS "mm")
)
(defun C:SETS (/ JWS)
  (if (null *JWS)
    (setq JWS "mm")
    (setq JWS *JWS)
  )
  (setq *JWS (JW-GETSTRING t "\n指定当前默认字符串" "mm"))
)


;;;点
(if (null *JWP)
  (setq *JWP '(0 0 0))
)
(defun C:SETP (/ JWP)
  (if (null *JWP)
    (setq JWP '(0 0 0))
    (setq JWP *JWP)
  )
  (princ "\n当前默认点:")
  (princ *JWP)
  (setq *JWP (JW-GETPOINT NIL "\n指定当前默认点"))

)

(defun C:R1 (/ ENAMES INT0 SS SS1 V1)
  (setvar "cmdecho" 0)
  (command ".undo" "be")
  (princ "\n删除小于某值的数字")
  (if (null *INT)
    (setq INT0 500)
    (setq INT0 *INT)
  )
  (setq *INT (JW-GETINT "\n删除小于某值的数字" INT0))
  (if (setq SS (ssget '((0 . "TEXT"))))
    (progn
      (setq ENAMES (JW-SS->ENAMES SS))
      (setq SS1 (ssadd))
      (foreach E ENAMES
 (setq V1 (read (JW-DXF E 1)))
 (if (and (numberp V1) (<= V1 *INT))
   (ssadd E SS1)
 )
      )
      (command "._erase" SS1 "")
    )
  )
  (command ".undo" "en")
  (princ)
)

(defun C:R2 (/ DATA ELST MO S SS V1 VAL YS)
  (setvar "cmdecho" 0)
  (command "._undo" "be")
  (princ "\n板筋长度数字取整")
  (setq MO (getint "\n 长度取整按<50>:"))
  (if (= MO NIL)
    (setq MO 50)
  )
  (if (<= MO 1)
    (alert "\n 提示:数值大于1才意义!")
    (if (and (> MO 1)
      (setq SS (ssget '((0 . "*TEXT"))))
 )
      (progn
 (setq ELST (JW-SS->ENAMES SS))
 (foreach E ELST
   (setq DATA (entget E))
   (setq V1 (cdr (assoc 1 DATA)))
   (if (numberp (read V1))
     (progn
       (setq V1 (atoi V1)) ;_数值
       (setq S (fix (/ V1 MO))) ;_商
       (setq YS (rem V1 MO)) ;_余数
       (if (and YS (/= YS 0))
  (progn
    (if (>= YS (* 0.5 MO))
      (setq VAL (* (+ S 1) MO))
      (setq VAL (* S MO))
    )
  )
  (setq VAL V1)
       )
       (setq VAL (itoa VAL))
       (setq DATA (subst (cons 1 VAL) (assoc 1 DATA) DATA))
       (entmod DATA)
     )
   )
 )
      )
      (alert "\n 请重新选择")
    )
  )
  (command "._undo" "en")
  (setvar "cmdecho" 1)
  (princ)
)

(defun C:R3 (/ E INT R3INT V0 V1 V42)
  (princ "\n几分几值")
  (while (setq E (car (entsel "\n选择文字或标注: ")))
    (setq V0 (JW-DXF E 0))
    (if (or (= V0 "DIMENSION")
     (= V0 "TEXT")
     (= V0 "MTEXT")
 )
      (progn
 (setq V1 (JW-DXF E 1))
 (setq V42 (JW-DXF E 42))
 (if (= V0 "DIMENSION")
   (setq V1 (rtos V42 2))
 )
 (if (numberp (read V1))
   (progn
     (if (null *R3INT)
       (setq R3INT 4)
       (setq R3INT *R3INT)
     )
     (setq *R3INT (JW-GETINT "\n指定分母" R3INT))
     (princ
       (strcat V1
        "除以"
        (itoa *R3INT)
        " = "
        (rtos (/ (read V1) *R3INT) 2)
       )
     )
   )
 )
      )
    )
  )
  (princ)
) 

(defun C:R4 (/    +-  ANG   DIS   E    ENT  EPAR  GPT   GPT1
      I    IND  MPAR  MPT   N    O  PAR   PT    PT1
      PT2   PTN  PTO   PTON  SPAR  VLAPTO
     )
  (vl-load-com)
  (princ "\n板钢筋伸缩")
  (setvar "cmdecho" 0)
  (command "._undo" "begin")
  (if (and (setq ENT (entsel "\n选择板钢筋<退出>: "))
    (setq GPT (getpoint "\n指定点<退出>: "))
      )
    (progn
      (setq E  (car ENT)
     PT (cadr ENT)
     O  (vlax-ename->vla-object E)
     PT (vlax-curve-getclosestpointto O PT)
      )

      (setq SPAR (vlax-curve-getstartparam O)
     EPAR (vlax-curve-getendparam O)
     MPAR (* 0.5 (- EPAR SPAR))
     PAR  (vlax-curve-getparamatpoint O PT)
     MPT  (vlax-curve-getpointatparam O MPAR)
     ANG  (JW-ANGLE-CURVEPT E MPT)
      )

      (setq GPT1 (polar GPT (+ (* 0.5 pi) ANG) 1))
      (setq IND (fix MPAR))

      (cond ((< PAR MPAR) ;_参数往下减
      (setq PT1 (vlax-curve-getpointatparam O IND)
     PT2 (vlax-curve-getpointatparam O (+ IND 1))
     I   0
     +-  -
      )
     )
     ((> PAR MPAR) ;_参数往上加
      (setq PT2 (vlax-curve-getpointatparam O IND)
     PT1 (vlax-curve-getpointatparam O (+ IND 1))
     I   1
     +-  +
      )
     )
      )
      (setq PTO (inters PT1 PT2 GPT GPT1 NIL)
     DIS (distance PT1 PTO)
     ANG (angle PT1 PTO)
      )
      (repeat (+ IND 1)
 (setq N (+- IND I))
 (setq PTN (JW-VAR->LIST (vla-get-coordinate O N)))
 (setq PTON (polar PTN ANG DIS))
 (setq VLAPTO (vlax-make-safearray vlax-vbdouble '(0 . 1)))
 (vlax-safearray-fill VLAPTO PTON)
 (vla-put-coordinate O N VLAPTO)
 (setq I (1+ I))
      )
    )
  )
  (command "._undo" "end")
  (princ)
)


;;;梁 系列:
(defun C:T1 (/ A AREA ENT LST N NUM V1)
  ;;全局变量*JWI 钢筋直径 
  (princ "\n一二级框架梁通长筋计算,直径>=14")
  (while (setq ENT (entsel "\n选择计算面积(如7-6-7)<退出>: "))
    (redraw (car ENT) 3)
    (setq V1 (cdr (assoc 1 (entget (car ENT)))))
    (setq LST (JW-STRING-SPLIT V1 "-"))
    (setq NUM (apply 'max (mapcar 'read LST)))
    (setq A (* 0.25 *JWI *JWI pi))
    (setq AREA (* 100 (/ NUM 4)))
    (setq N (rtos (/ AREA A) 2 1))
    (princ (strcat" " (itoa NUM) " 需要<" N ">根" (itoa *JWI) "通长筋"))
    (redraw (car ENT) 4)
  )
  (princ)
)
(defun C:T3 (/ ENAMES INT0 LST NUM SS SS1 V1)
  (princ "\n选择计算面积大于某个值<如7-6-7>")
  (if (null *INT)
    (setq INT0 40)
    (setq INT0 *INT)
  )
  (setq *INT (JW-GETINT "\n输入计算面积大于某个值" INT0))
  (if (setq SS (ssget '((0 . "TEXT") (1 . "*-*-*"))))
    (progn
      (setq ENAMES (JW-SS->ENAMES SS))
      (setq SS1 (ssadd))
      (foreach E ENAMES
 (setq V1 (cdr (assoc 1 (entget E))))
 (setq LST (JW-STRING-SPLIT V1 "-"))
 (setq NUM (apply 'max (mapcar 'read LST)))
 (if (>= NUM *INT)
   (ssadd E SS1)
 )
      )
      (sssetfirst NIL SS1)
    )
  )
  (princ)
)
(vl-load-com)
(defun C:T4 (/ LST NUM O SS V1)
  (princ "\n显梁超筋配筋率")
  (princ "\n配筋率大于2.5时显红色,在2.5与2.0区间显绿色")
  (if (setq SS (ssget '((0 . "TEXT") (1 . "*%-*%-*%"))))
    (foreach E (JW-SS->ENAMES SS)
      (setq O (vlax-ename->vla-object E))
      (setq V1 (cdr (assoc 1 (entget E))))
      (setq LST (JW-STRING-SPLIT V1 "-"))
      (setq NUM (apply 'max (mapcar 'read LST)))
      (cond ((>= 2.5 NUM 2.0) (vla-put-color O acgreen))
     ((>= NUM 2.5) (vla-put-color O acred))
      )
    )
  )
  (princ)
) 
(defun C:T5 (/ A ENT LST N NUM V1)
  (princ "\梁配筋根数计算")
  (while (setq ENT (entsel "\n选择计算面积(如7-6-7)<退出>: "))
    (setq V1 (cdr (assoc 1 (entget (car ENT)))))
    (setq LST (JW-STRING-SPLIT V1 "-"))
    (setq NUM (apply 'max (mapcar 'read LST)))
    (setq A (* 0.25 *JWI *JWI pi))
    (setq N (rtos (/ (* 100 NUM) A) 2 1))
    (princ (strcat " " (itoa NUM) "需要<" N ">根" (itoa *JWI)))
  )
  (princ)
)

(defun C:T6 (/ A ENT LST N NUM V1)
  (princ "\n一般梁梁端支座区>=梁跨中下部的1/4")
  (while (setq ENT (entsel "\n选择梁跨中下部计算面积(如7-6-7)<退出>: "))
    (setq V1 (cdr (assoc 1 (entget (car ENT)))))
    (setq LST (JW-STRING-SPLIT V1 "-"))
    (setq NUM (apply 'max (mapcar 'read LST)))
    (setq A (* 0.25 *JWI *JWI pi))
    (setq N (rtos (/ (* (* 100 NUM) 0.25) A) 2 1))
    (princ (strcat "梁端支座区" "至少需要<" N ">根" (itoa *JWI))
    )
  )
  (princ)
)

(defun C:T7 (/ A ENT LST N NUM V1)
  (princ "\n二、三级抗震等级")
  (princ "\n框架梁梁端截面的底部和顶部比值>=0.3")
  (while (setq ENT (entsel "\n选择梁端顶部计算面积(如7-6-7)<退出>: "))
    (setq V1 (cdr (assoc 1 (entget (car ENT)))))
    (setq LST (JW-STRING-SPLIT V1 "-"))
    (setq NUM (apply 'max (mapcar 'read LST)))
    (setq A (* 0.25 *JWI *JWI pi))
    (setq N (rtos (/ (* 0.3 (* 100 NUM)) A) 2 1));_**
    (princ (strcat "梁端底部" "至少需要<" N ">根" (itoa *JWI)))
  )
  (princ)
) 
(defun C:TT (/ A ANG ENAMES I LANG MPT MPT1 MPT2 MPT3 MPT4 OSMODE SS V10
      V11)
  (princ "\n选择梁底配筋 如7-6-7")
  (setvar "cmdecho" 0)
  (setq OSMODE (getvar "osmode"))
  (setq SS (ssget '((0 . "LINE") (8 . "11000"))))
  (setq ENAMES (JW-SS->ENAMES SS))
  (setvar "osmode" 0)
  (command "._undo" "begin")
  (foreach E ENAMES
    (redraw E 3)
    ;;(setq E (car (entsel)))
    (setq V10 (JW-DXF E 10))
    (setq V11 (JW-DXF E 11))
    (setq MPT (JW-MIDPOINT V10 V11))
    (setq LANG (angle V10 V11))
    (setq ANG (- LANG (* 0.5 pi)))
    ;;(setq ANG (+ LANG (* 0.5 pi)));_选择线下文字
    (setq MPT1 (polar MPT LANG 0.1))
    (setq MPT3 (polar MPT1 ANG 0.1))
    (setq MPT2 (polar MPT (+ LANG pi) 0.1))
    (setq MPT4 (polar MPT2 ANG 0.1))
    (command "._rectang" "none" MPT1 "none" MPT4)
    (if (setq SS (ssget "C"
   MPT1
   MPT4
   '((0 . "TEXT") (1 . "*-*-*") (8 . "21000"))
   )
 )
      (progn
 (setq I 0)
 (while (< I (sslength SS))
   (if (not (equal (JW-DXF (ssname SS I) 50) LANG 0.1))
     (ssdel (ssname SS I) SS)
   )
   (setq I (1+ I))
 )
  (if (setq A (ssname SS 0))
    (command "._CHPROP" A "" "C" "1" "")
  )
 (redraw E 4)
      )
    )
  )
  (command "._undo" "end")
  (setvar "osmode" OSMODE)
  (princ)
)

(defun C:L1 (/ A B ELIST ENAMES LST SS SUBVAL V1)

  (JW-ENTMAKE-STYLE "TSSD_Rein" "tssdeng.shx" "hztxt.shx" 0.7)
  (setvar "cmdecho" 0)
  (princ "\n配主梁四肢箍筋(8 10一级钢)")
  (if (not (tblsearch "layer" "0setwe-zlkj"))
    (JW-ENTMAKE-LAYER "0setwe-zlkj" 2)
  )
  (if (setq SS (ssget '((0 . "TEXT") (1 . "G*-*"))))
    (progn
      (setq ENAMES (JW-SS->ENAMES SS))
      (foreach E ENAMES
 ;;(setq E (car (entsel)))
 (setq ELIST (entget E))
 (setq V1 (cdr (assoc 1 ELIST)))
 (setq V1 (substr V1 2 (strlen V1)))
 (setq ELIST (JW-DXF-SUBST 8 "0setwe-zlkj" ELIST))
 (setq ELIST (JW-DXF-SUBST 7 "TSSD_Rein" ELIST))

 (setq LST (JW-STRING-SPLIT V1 "-"))

 (setq A (read (car LST)))
 (setq B (read (cadr LST)))

 (setq SUBVAL (LKJ-REPLACE-4Z A B))
 ;;(setq SUBVAL (LKJ-REPLACE-2Z A B))

 (if SUBVAL
   (entmake (JW-DXF-SUBST 1 SUBVAL ELIST))
 )
      )
    )
  )
  (princ)
)

 

;;;主梁
;;配四肢箍的...最近正在配地下室的梁...350宽以上的主梁,大家可以根据自己的习惯修改
(defun LKJ-REPLACE-4Z (A B)
  (cond ((>= A 4.52) (setq SUBVAL NIL))
 ((>= 4.52 A 3.14)
  (cond ((> B 4.52) (setq SUBVAL NIL))
        ((> 4.52 B 3.77) (setq SUBVAL "%%13112@100(4)"))
        ((> 3.77 B 3.375) (setq SUBVAL "%%13112@100/120(4)"))
        ((> 3.375 B 2.66) (setq SUBVAL "%%13112@100/150(4)"))
        ((> 2.66 B) (setq SUBVAL "%%13112@100/200(4)"))
  )
 )
 ((AND (> A 2.0) (< A 3.14))
  (cond ((> B 3.14) (setq SUBVAL NIL))
        ((or (= B 2.7) (= B 2.8) (= B 2.9) (= B 3.0) (= B 3.1)) (setq SUBVAL "%%13010@100(4)"))
        ((or (= B 2.1) (= B 2.2) (= B 2.3) (= B 2.4) (= B 2.5) (= B 2.6))  (setq SUBVAL "%%13010@100/120(4)"))
        ((or (= B 1.6) (= B 1.7) (= B 1.8) (= B 1.9) (= B 2.0)) (setq SUBVAL "%%13010@100/150(4)"))
        ((>= 1.57 B) (setq SUBVAL "%%13010@100/200(4)"))
  )
 )
 ((AND (> A 0.0) (<= A 2.0))
  (cond ((> B 2.0) (setq SUBVAL NIL))
        ((or (= B 1.7) (= B 1.8) (= B 1.9) (= B 2.0))  (setq SUBVAL "%%1308@100(4)"))
        ((or (= B 1.4) (= B 1.5) (= B 1.6)) (setq SUBVAL "%%1308@100/120(4)"))
        ((or (= B 1.3) (= B 1.2) (= B 1.1)) (setq SUBVAL "%%1308@100/150(4)"))
        ((>= 1.0 B) (setq SUBVAL "%%1308@100/200(4)"))
  )
 )
  )
  SUBVAL
)
;;;;严重注明:这个只是写了用来配二肢箍的次梁...

(defun C:L2 (/ A B ELIST ENAMES LST SS SUBVAL V1)

  (JW-ENTMAKE-STYLE "TSSD_Rein" "tssdeng.shx" "hztxt.shx" 0.7)
  (setvar "cmdecho" 0)
  (princ "\n配次梁箍筋(8 10一级钢)")
  (if (not (tblsearch "layer" "0setwe-clkj"))
    (JW-ENTMAKE-LAYER "0setwe-clkj" 2)
  )
  (if (setq SS (ssget '((0 . "TEXT") (1 . "G*-*"))))
    (progn
      (setq ENAMES (JW-SS->ENAMES SS))
      (foreach E ENAMES
 ;;(setq E (car (entsel)))
 (setq ELIST (entget E))
 (setq V1 (cdr (assoc 1 ELIST)))
 (setq V1 (substr V1 2 (strlen V1)))
 (setq ELIST (JW-DXF-SUBST 8 "0setwe-clkj" ELIST))
 (setq ELIST (JW-DXF-SUBST 7 "TSSD_Rein" ELIST))

 (setq LST (JW-STRING-SPLIT V1 "-"))

 (setq A (read (car LST)))
 ;;(setq B (read (cadr LST)))
 (setq SUBVAL (LKJ-REPLACE-2Z A))

 (if SUBVAL
   (entmake (JW-DXF-SUBST 1 SUBVAL ELIST))
 )
      )
    )
  )
  (princ)
)

;;配二肢箍的...次梁
(defun LKJ-REPLACE-2Z (A)
  (cond ((> A 3.22) (setq SUBVAL NIL))
 ((or (= A 2.8)
      (= A 2.9)
      (= A 3.0)
      (= A 3.1)
      (= A 3.2)
  )
  (setq SUBVAL "%%13112@100(2)")
 )
 ((or (= A 2.2)
      (= A 2.3)
      (= A 2.4)
      (= A 2.5)
      (= A 2.6)
      (= A 2.7)
  )
  (setq SUBVAL "%%13112@120(2)")
 )
 ((or (= A 1.7)
      (= A 1.8)
      (= A 1.9)
      (= A 2.0)
      (= A 2.1)
  )
  (setq SUBVAL "%%13112@150(2)")
 )
 ((or (= A 1.1) (= A 1.2) (= A 1.3) (= A 1.4) (= A 1.5) (= A 1.6))
  (setq SUBVAL "%%13112@200(2)")
 )

 ((or (= A 0.8) (= A 0.9) (= A 1.0))
  (setq SUBVAL "%%13010@150(2)")
 )
 ((= A 0.7) (setq SUBVAL "%%13010@200(2)"))

 ((= A 0.6) (setq SUBVAL "%%1308@150(2)"))
 ((or (= A 0.5)
      (= A 0.4)
      (= A 0.3)
      (= A 0.2)
      (= A 0.1)
      (= A 0.0)
  )
  (setq SUBVAL "%%1308@200(2)")
 )
  )
  SUBVAL
)

(defun C:L3 (/ A ELIST ENAMES LST RETURN SS SUBVAL V1)

  (JW-ENTMAKE-STYLE "TSSD_Rein" "tssdeng.shx" "hztxt.shx" 0.7)
  (setvar "cmdecho" 0)
  (princ "\n配主梁纵筋")
  (if (not (tblsearch "layer" "0setwe-zlzj"))
    (JW-ENTMAKE-LAYER "0setwe-zlzj" 2)
  )
  (if (setq SS (ssget '((0 . "TEXT") (1 . "*-*-*"))))
    (progn
      (setq ENAMES (JW-SS->ENAMES SS))
      (foreach E ENAMES
 ;;(setq E (car (entsel)))
 (setq ELIST (entget E))
 (setq V1 (cdr (assoc 1 ELIST)))
 (setq ELIST (JW-DXF-SUBST 8 "0setwe-zlzj" ELIST))
 (setq ELIST (JW-DXF-SUBST 7 "TSSD_Rein" ELIST))

 (setq LST (JW-STRING-SPLIT V1 "-"))

 (setq SUBVAL (mapcar '(lambda (A)
    (if (null (ZLZJ-REPLACE A))
      A
      (ZLZJ-REPLACE A)
    )
         )
        LST
       )
 )

 (if (setq RETURN (strcat (car SUBVAL)
     "="
     (cadr SUBVAL)
     "="
     (caddr SUBVAL)
    )
     )
   (entmake (JW-DXF-SUBST 1 RETURN ELIST))
 )
      )
    )
  )
  (princ)
)

(defun ZLZJ-REPLACE (A)
  (setq A (read A))
  (cond ((> A 118) (setq SUBVAL NIL))
 ((>= 118 A 114) (setq SUBVAL "24D25"))
 ((>= 113 A 109) (setq SUBVAL "23D25"))
 ((>= 108 A 104) (setq SUBVAL "22D25"))
 ((>= 103 A 99) (setq SUBVAL "21D25"))
 ((>= 98 A 94) (setq SUBVAL "20D25"))
 ((>= 93 A 89) (setq SUBVAL "19D25"))
 ((>= 88 A 84) (setq SUBVAL "18D25"))
 ((>= 83 A 79) (setq SUBVAL "17D25"))
 ((>= 78 A 74) (setq SUBVAL "16D25"))
 ((>= 73 A 70) (setq SUBVAL "15D25"))
 ((>= 69 A 64) (setq SUBVAL "14D25"))
 ((>= 63 A 60) (setq SUBVAL "13D25"))
 ((>= 59 A 55) (setq SUBVAL "12D25"))
 ((>= 54 A 50) (setq SUBVAL "11D25"))
 ((>= 49 A 45) (setq SUBVAL "10D25"))
 ((>= 44 A 40) (setq SUBVAL "9D25"))
 ((>= 39 A 35) (setq SUBVAL "8D25"))
 ((>= 34 A 30) (setq SUBVAL "7D25"))
 ((>= 29 A 25) (setq SUBVAL "6D25"))
 ((>= 24 A 20) (setq SUBVAL "5D25"))
 ((>= 19 A 15) (setq SUBVAL "4D25"))
 ((> 15 A) (setq SUBVAL NIL))
  )
  SUBVAL
)

(defun C:L4 (/ A ELIST ENAMES LST RETURN SS SUBVAL V1)
  (setvar "cmdecho" 0)
  (princ "\n配次梁纵筋")
  (if (not (tblsearch "layer" "0setwe-clzj"))
    (JW-ENTMAKE-LAYER "0setwe-clzj" 2)
  )
  (if (setq SS (ssget '((0 . "TEXT") (1 . "*-*-*"))))
    (progn
      (setq ENAMES (JW-SS->ENAMES SS))
      (foreach E ENAMES
 ;;(setq E (car (entsel)))
 (setq ELIST (entget E))
 (setq V1 (cdr (assoc 1 ELIST)))
 (setq ELIST (JW-DXF-SUBST 8 "0setwe-clzj" ELIST))
 (setq ELIST (JW-DXF-SUBST 7 "TSSD_Rein" ELIST))

 (setq LST (JW-STRING-SPLIT V1 "-"))

 (setq SUBVAL (mapcar '(lambda (A)
    (if (null (CLZJ-REPLACE A))
      A
      (CLZJ-REPLACE A)
    )
         )
        LST
       )
 )

 (if (setq RETURN (strcat (car SUBVAL)
     "="
     (cadr SUBVAL)
     "="
     (caddr SUBVAL)
    )
     )
   (entmake (JW-DXF-SUBST 1 RETURN ELIST))
 )
      )
    )
  )
  (princ)
)

;;配二肢箍的...次梁
(defun CLZJ-REPLACE (A)
  (setq A (read A))
  (cond ((> A 118) (setq SUBVAL NIL))
 ((>= 118 A 114) (setq SUBVAL "24D25"))
 ((>= 113 A 109) (setq SUBVAL "23D25"))
 ((>= 108 A 104) (setq SUBVAL "22D25"))
 ((>= 103 A 99) (setq SUBVAL "21D25"))
 ((>= 98 A 94) (setq SUBVAL "20D25"))
 ((>= 93 A 89) (setq SUBVAL "19D25"))
 ((>= 88 A 84) (setq SUBVAL "18D25"))
 ((>= 83 A 79) (setq SUBVAL "17D25"))
 ((>= 78 A 74) (setq SUBVAL "16D25"))
 ((>= 73 A 70) (setq SUBVAL "15D25"))
 ((>= 69 A 64) (setq SUBVAL "14D25"))
 ((>= 63 A 60) (setq SUBVAL "13D25"))
 ((>= 59 A 55) (setq SUBVAL "12D25"))
 ((>= 54 A 50) (setq SUBVAL "11D25"))
 ((>= 49 A 45) (setq SUBVAL "10D25"))
 ((>= 44 A 40) (setq SUBVAL "9D25"))
 ((>= 39 A 35) (setq SUBVAL "8D25"))
 ((>= 34 A 30) (setq SUBVAL "7D25"))
 ((>= 29 A 25) (setq SUBVAL "6D25"))
 ((>= 24 A 20) (setq SUBVAL "5D25"))
 ((or (= A 19) (= A 18) (= A 17) (= A 16))
  (setq SUBVAL "4D25")
 )
 ((or (= A 15) (= A 14) (= A 13)) (setq SUBVAL "4D22"))
 ((= A 12) (setq SUBVAL "4D20"))
 ((or (= A 11) (= A 10)) (setq SUBVAL "3D22"))
 ((or (= A 9) (= A 8)) (setq SUBVAL "3D20"))
 ((= A 7) (setq SUBVAL "3D18"))
 ((= A 6) (setq SUBVAL "3D16"))
 ((= A 5) (setq SUBVAL "2D18"))
 ((= A 4) (setq SUBVAL "2D16"))
 ((or (= A 3) (= A 2) (= A 1)) (setq SUBVAL "2D14"))
  )
  SUBVAL
)

;;;配板筋
(defun C:B1 (/ ELIST ENAME I SS V1)
  (defun BJ-REPLACE (A1 A2 A3 V1 ELIST)
    (if (and (numberp V1) (<= A1 V1 A2))
      (entmod (JW-DXF-SUBST 1 A3 ELIST))
    )
  )
  (princ "\n选择板计算结果(≥10二级钢)")
  (if (setq SS (ssget '((0 . "TEXT"))))
    (progn
      (setq I -1)
      (repeat (sslength SS)
 (setq ENAME (ssname SS (setq I (1+ I))))
 (setq ELIST (entget ENAME))

 ;;修改文字为左对齐
 (setq ELIST (JW-DXF-SUBST 72 0 ELIST))
 (setq ELIST (JW-DXF-SUBST 73 0 ELIST))
 (entmod ELIST)

 ;;修改文字宽度为0.7,高度为300
 (setq ELIST (JW-DXF-SUBST 40 300 ELIST))
 (setq ELIST (JW-DXF-SUBST 41 0.7 ELIST))
 (setq V1 (read (cdr (assoc 1 ELIST))))
 (entmod ELIST)

 ;;修改配筋
 (BJ-REPLACE 1345 1615 "%%13112@100" V1 ELIST)
 (BJ-REPLACE 1121 1345 "%%13112@120" V1 ELIST)
 (BJ-REPLACE 1077 1121 "%%13110@100" V1 ELIST)
 (BJ-REPLACE 934 1077 "%%13112@150" V1 ELIST)
 (BJ-REPLACE 807 934 "%%13110@120" V1 ELIST)
 (BJ-REPLACE 749 807 "%%13112@200" V1 ELIST)
 (BJ-REPLACE 623 749 "%%13110@150" V1 ELIST)
 (BJ-REPLACE 560 623 "%%13110@180" V1 ELIST)
 (BJ-REPLACE 500 560 "%%13110@200" V1 ELIST)
 (BJ-REPLACE 419 500 "%%1308@100" V1 ELIST)
 (BJ-REPLACE 335 419 "%%1308@120" V1 ELIST)
 (BJ-REPLACE 279 335 "%%1308@150" V1 ELIST)
 (BJ-REPLACE 251 279 "%%1308@180" V1 ELIST)
 (BJ-REPLACE 0 251 "%%1308@200" V1 ELIST)
      )
    )
  )
)