[LISP程序]：输入钢筋数量后根据梁宽、保护层等自动排钢筋

qiaqiadeng

本程序弹出对话框
(defun *$dyq-error$* (msg)
  ;(command ".undo" "")
  (setq *error* &olderr&)
  ;(princ)
)

(defun dyq-findstr (strstr fstr ii / i lenstr astr)
;若自左向右查找则ii=1，否则ii=-1，ii为其他数字将不被允许
  (setq lenstr (strlen strstr))
  (setq lenfstr (strlen fstr))
  (setq astr 0)
  (if (= ii 1)
    (setq i 1)
    (setq i (- lenstr lenfstr -1))
  )
  (repeat (- lenstr lenfstr -1)
    (if        (= (substr strstr i lenfstr) fstr)
      (setq astr i)
    )
    (setq i (+ i ii))
  )
  astr
)

(defun c:ax (/ neirong n d wz wzlist)
  (princ "直接输入钢筋数量、直径")
  (setq &olderr& *error*)
  (setq *error* *$dyq-error$*)
  (setq dcldirect "c:/dyqdcl.dcl")
  (if (findfile "c:/HRB.txt")
    (progn
      (setq f (open "c:/HRB.txt" "r"))
      (setq hrb (read-line f)) ;钢筋等级
      (setq b (read-line f)) ;梁宽
      (setq as (read-line f)) ;保护层厚
      (setq po_position (read-line f)) ;钢筋位置
      (close f)
    )
    (progn
      (setq hrb "1") ;钢筋等级
      (setq b "200") ;梁宽
      (setq as "25") ;保护层厚
      (setq po_position "支座") ;钢筋位置
    )
  )
  (setq f (open dcldirect "w")) ;将对话框输入到文件
  (write-line "dyq_ax:dialog" f)
  (write-line "{label=\"输入钢筋\";" f)
  (write-line ":popup_list {" f)
  (write-line "label=\"\";" f)
  (write-line "key=\"dim\";" f)
  (write-line "width=5;" f)
  (write-line "list=\"HPB235\\nHRB335\\nHRB400\";" f)
  (write-line "value=0;" f)
  (write-line "}" f)

  (write-line ":edit_box {" f)
  (write-line (strcat "key=BeamWide;") f)
  (write-line "width=5;" f)
  (write-line "label=\"梁宽:\";" f)
  (write-line "edit_width=5;" f)
  (write-line "fixed_width=true;" f)
  (write-line "alignment=centered;" f)
  (write-line "is_enabled=true;" f)
  (write-line "value=200;" f)
  (write-line "}" f)

  (write-line ":edit_box {" f)
  (write-line (strcat "key=baohuceng;") f)
  (write-line "width=5;" f)
  (write-line "label=\"保护层厚:\";" f)
  (write-line "edit_width=5;" f)
  (write-line "fixed_width=true;" f)
  (write-line "alignment=centered;" f)
  (write-line "is_enabled=true;" f)
  (write-line "value=25;" f)
  (write-line "}" f)


  (write-line ":boxed_radio_column {" f)
  (write-line "label=\"钢筋位置\";" f)
  (write-line
    ":radio_button {label=\"支座\";key=\"zhizuo\";}"
    f
  )
  (write-line
    ":radio_button {label=\"底筋\";key=\"dijin\";}"
    f
  )
  (write-line "}" f)

  (write-line "ok_only;" f)
  (write-line "}" f)
  (close f)
  (new_dialog
    "dyq_ax"
    (load_dialog dcldirect)
  )
  (set_tile "dim" hrb)
  (set_tile "BeamWide" b)
  (set_tile "baohuceng" as)
  (if (= po_position "支座")
    (set_tile "zhizuo" "1")
    (set_tile "dijin" "1")
  )
  (action_tile
    "dim"
    "(setq hrb         (get_tile $key)
          fylist (get_attr $key \"list\"))"
  )
  (action_tile
    "BeamWide"
    "(setq b (get_tile $key))"
  )
  (action_tile
    "baohuceng"
    "(setq as (get_tile $key))"
  )
  (action_tile
    "zhizuo"
    "(setq po_position (get_attr  $key \"label\"))"
  )
  (action_tile
    "dijin"
    "(setq po_position (get_attr  $key \"label\"))"
  )

  (start_dialog)
  (setq f (open "c:/HRB.txt" "w"))
  (write-line hrb f) ;钢筋等级
  (write-line b f) ;梁宽
  (write-line as f) ;保护层厚
  (write-line po_position f) ;钢筋位置
  (close f)
  (setq b (atof b))
  (setq as (atof as))

  (setq neirong "")
  (while (and (setq n (getint "\n请输入钢筋根数:"))
              (setq d (getint "\n请输入钢筋直径:"))
         )
    (setq neirong
           (strcat neirong "+" (itoa n) (strcat "%%13" hrb) (itoa d))
    )
  )
  (setq neirong (substr neirong 2 (strlen neirong)))
  (setq
    neirong (check_n_text neirong b po_position as)
  )
  (if (/= neirong "")
    (while (setq wz (entsel "\n请点取要修改的文字:"))
      (setq wzlist (entget (car wz)))
      (setq oldneirong (cdr (assoc '1 wzlist)))
      (if (wcmatch oldneirong "*;*,*；*,*；*,*；*") ;如果是集中标注
        (progn
          (setq key1 (dyq-findstr oldneirong ";" 1))
          (setq key2 (dyq-findstr oldneirong "；" 1))
          (setq key3 (dyq-findstr oldneirong "；" 1))
          (setq key4 (dyq-findstr oldneirong "；" 1))
          (setq key (max key1 key2 key3 key4)) ;获得;的位置

          (if (= po_position "支座")
            (setq neirong (strcat neirong (substr oldneirong key)))
;如果是支座
            (setq neirong (strcat (substr oldneirong 1 key) neirong))
;如果是底筋
          )
        )
      )
      (setq wzlist
             (subst (cons '1 neirong)
                    (assoc '1 wzlist)
                    wzlist
             )
      )
      (entmod wzlist)
      (setq f (open "c:/clipboard.txt" "w"))
      (write-line neirong)
      (close f)
    )
  )
  (setq *error* &olderr&)
  (princ)
)

sfjlx

支持下!一看就是结构的苦命人!

zml84

楼主的这个东西的想法是不错的，有点智能化的意思；
但解决问题的方法过于烦琐了，不利于集成。
<br>
实现某一特定功能的代码最好做成模块化函数，这样才能更好的被自己和别人所用。

tc405003

楼主，程序好像执行了没有结果

qiaqiadeng

要点一个图中的文字才能看到修改结果

dwg001

反复在询问：
ax 直接输入钢筋数量、直径
请输入钢筋根数:5
请输入钢筋直径:20
请输入钢筋根数:4
请输入钢筋直径:22
请输入钢筋根数:

无结果。
请问楼主，还有何技巧？

qiaqiadeng

反复在询问：
ax 直接输入钢筋数量、直径
请输入钢筋根数:5
请输入钢筋直径:20
请输入钢筋根数:4
请输入钢筋直径:22
请输入钢筋根数:空格
请点取要修改的文字:点取一个原位标注
比如原位标注原先为5%%13125,如果梁宽为200,那么，现在就变成5%%13125 3/2了，楼上的可明白？

rocbirds

最好能做成一个直接加载的lisp

它山之石

这种程序应该再智能下
至少原位标注的钢筋能自动取得梁宽
再进一步就是利用反应器如果修改了钢筋标注就会自动来调整根数和排数

tc405003

楼主，按你说的方法都试了，还是不行;仔细检查了一下你的程序，发现少了子程序check_n_text
可否再贴上少了的子程序让大家试试

qiaqiadeng

不好意思，最关键的排钢筋的程序丢了，现补上,纵观论坛，楼上的程序好像比较实用，能否单独切磋一下？
(defun check_n_text
                    (neirong  b               po_position         bao          /           weiba    po_blank num      n_list   d_list
                     pai_list tempstring        i         j          key1           key2            n_list1  d_list1  NOpai    keyi
                     keyj     ni       maxd0        sumnd0         maxd1          num1           sumnd1   gap             npai     NewWeiba numa
                    )
  ;b为传过来的梁宽,po_position为梁筋位置：上、底,bao保护层厚度
  ;检查原位标注的钢筋根数是否正确，仅考虑三种钢筋组合的情况
  (defun maxd (n_list_find d_list_find start1 end1 / maxd i)
    (setq maxd 0)
    (setq i start1)
    (repeat (- end1 start1 -1)
      (if (> (cadr (assoc i n_list_find)) 0)
        (setq maxd (max maxd (cadr (assoc i d_list_find))))
      )
      (setq i (+ i 1))
    )
    maxd
  )

  (defun sumn (n_list_find start1 end1 / sumd i) ;求指定区间的钢筋根数
    (setq sumd 0)
    (setq i start1)
    (repeat (- end1 start1 -1)
      (setq sumd (+ sumd (cadr (assoc i n_list_find))))
      (setq i (+ i 1))
    )
    sumd
  )

  (defun sumnd (n_list_find d_list_find start1 end1 / sumnd i)
  ;求指定区间的根数乘钢筋直径
    (setq sumnd 0)
    (setq i start1)
    (repeat (- end1 start1 -1)
      (setq sumnd (+ sumnd
                     (*        (cadr (assoc i n_list_find))
                        (cadr (assoc i d_list_find))
                     )
                  )
      )
      (setq i (+ i 1))
    )
    sumnd
  )

  (setq neirong (vl-string-trim " " neirong)) ;掐头去尾再次保证无空格
  (setq neirong (dyq-string-subst " " "  " neirong))
  ;去除连续的两个空格
  (setq weiba "")
  (if (wcmatch neirong "* *")
    (progn
      (setq po_blank (vl-string-search " " neirong))
      (setq weiba (substr neirong (+ po_blank 2)))
      (setq neirong (substr neirong 1 po_blank))
    )
  )
  (setq num (dyq-string-count neirong "%%13#"))
  ;获得有几种钢筋组合，比较方法同wcmatch，可以采用通配符#、@等
  (setq n_list (list '(0 "n"))) ;存钢筋根数n
  (setq d_list (list '(0 "d"))) ;存钢筋直径d
  (setq pai_list (list '(0 "p"))) ;存放各排钢筋的数量
  (setq tempstring (strcat neirong "+"))
  (setq i 1)
  (repeat num
    (setq key1 (vl-string-search "%%13" tempstring))
    (setq key2 (vl-string-search "+" tempstring))
    (setq n_list
           (cons (list i (atoi (substr tempstring 1 key1))) n_list)
    )
    (setq d_list
           (cons (list i
                       (atoi (substr tempstring (+ key1 6) (- key2 key1 5)))
                 )
                 d_list
           )
    )
    (setq tempstring (substr tempstring (+ key2 2)))
    (setq i (+ i 1))
  )
  (setq n_list (reverse n_list))
  (setq d_list (reverse d_list))
  (setq n_list1 n_list)
  (setq d_list1 d_list)
  (setq NOpai 1) ;第几排
  (while (> (cadr (assoc num n_list1)) 0)
    (setq i 1)
    (setq keyi 0)
    (setq keyj 0)
    (repeat num
      (setq ni (cadr (assoc i n_list1))) ;第i张表里的钢筋根数
      (setq j 1)
      (setq maxd0 (max (maxd n_list1 d_list1 1 (- i 1))
                       (cadr (assoc i d_list1))
                  )
      ) ;i以前的直径最大值
      (setq num0 (sumn n_list1 1 (- i 1))) ;i以前的钢筋数量
      (setq sumnd0 (sumnd n_list1 d_list1 1 (- i 1)))
      (repeat ni
        (setq maxd1 (max maxd0 (cadr (assoc i d_list1)))) ;最大直径
        (setq num1 (+ num0 j)) ;钢筋数量
        (if (= num1 1)
          (setq num1 2)
        )
        (setq sumnd1 (+ sumnd0 (* j (cadr (assoc i d_list1)))))
  ;nXd的总和
        (setq gap (/ (- b bao bao sumnd1) (- num1 1.0))) ;钢筋净间距
        (if (and (= po_position "支座")
                 (>= gap 30.0)
                 (>= gap (* 1.5 maxd1))
            ) ;支座情况
          (progn
            (setq keyi i)
            (setq keyj j)
          )
        )
        (if (and (/= po_position "支座") (>= gap 25.0) (>= gap maxd1))
  ;底筋情况
          (progn
            (setq keyi i)
            (setq keyj j)
          )
        )
        (setq j (+ j 1))
      ) ;repeat ni now is end
      (setq i (+ i 1))
    ) ;repeat num now is end
    (setq npai (+ (sumn n_list1 1 (- keyi 1)) keyj)) ;本排钢筋的根数
    (setq pai_list (cons (list NOpai npai) pai_list))
    (setq i 1)
    (repeat (- keyi 1) ;将keyi前的钢筋根数改为0
      (setq n_list1 (subst (list i 0) (assoc i n_list1) n_list1))
      (setq i (+ i 1))
    )
    (setq n_list1 (subst (list i (- (cadr (assoc keyi n_list1)) keyj))
                         (assoc keyi n_list1)
                         n_list1
                  )
    ) ;将keyi个表里的钢筋根数-keyj
    (setq NOpai (+ NOpai 1))
  )
  (setq pai_list (reverse pai_list))
  (setq NewWeiba "")

  (setq numa (- (length pai_list) 1)) ;钢筋的排数
  ;以下处理4/1,3/1的情况，2/1的情况需要用户来确定，程序不做处理
  (if (= (cadr (assoc numa pai_list)) 1)
    (progn
      (setq
        pai_list (subst        (list (- numa 1)
                              (- (cadr (assoc (- numa 1) pai_list)) 1)
                        )
                        (assoc (- numa 1) pai_list)
                        pai_list
                 )
      ) ;将倒数第2排钢筋数-1
      (setq
        pai_list (subst (list numa 2) (assoc numa pai_list) pai_list)
      ) ;将倒数第1排钢筋数设为2
    )
  )
  (if (= po_position "支座")
    (setq i 1)
    (setq i numa)
  )
  (repeat numa
    (setq
      NewWeiba (strcat NewWeiba (itoa (cadr (assoc i pai_list))) "/")
    )
    (if        (= po_position "支座")
      (setq i (+ i 1))
      (setq i (- i 1))
    )
  )

  (setq NewWeiba (substr NewWeiba 1 (- (strlen NewWeiba) 1)))
  (if (= numa 1)
    (setq neirong neirong)
    (setq neirong (strcat neirong " " NewWeiba))
  )
)

tc405003

多谢楼主贴上程序，不过试了还是不行，输完钢筋就没有反应;不提示选择钢筋，输完根数及直径就退出
经查验，少DYQ-STRING-SUBST这个子程序

JQKA

不错，正是我想要的，试试


不行啊
输完根数及直径就退出
空格也一样啊！
？？？