[LISP函数]：层高表自动生成

qiaqiadeng

在CAD文件里写一个层高信息的文字，比如：”6   3.9 *3  2.8*25“，那么，执行下面程序后，点取该文字后就生成一个层高表，层高为6、3.9 3.9  3.9  2.8 2.8 2.8...，建筑面层是3cm还是5cm，由你自己定，程序会自动扣除面层后得到结构标高，如输入3cm，则+-0.000的结构标高就是-0.030，不多说了，是搞结构的应该懂了。
(defun dyq-get-oldstatus (/ oldstatus)        ;存储系统原状态
  (setq oldstatus (list "oldstatus"))
  (setq oldstatus (cons "CLAYER" oldstatus))
  (setq oldstatus (cons (getvar "CLAYER") oldstatus))
  (setq oldstatus (cons "OSMODE" oldstatus))
  (setq oldstatus (cons (getvar "OSMODE") oldstatus))
  (setq oldstatus (cons "ORTHOMODE" oldstatus))
  (setq oldstatus (cons (getvar "ORTHOMODE") oldstatus))
  (setq oldstatus (cons "TEXTSTYLE" oldstatus))
  (setq oldstatus (cons (getvar "TEXTSTYLE") oldstatus))
  (setq oldstatus (cons "TEXTSIZE" oldstatus))
  (setq oldstatus (cons (getvar "TEXTSIZE") oldstatus))
                                        ;当前标注样式要修改
  (setq oldstatus (reverse oldstatus))
)

(defun dyq-put-oldstatus (oldstatus)        ;还原系统原系统变量
  (setq num (length oldstatus))
  (setq i 1)
  (repeat (/ (- num 1) 2)
    (setvar (nth i oldstatus) (nth (+ i 1) oldstatus))
    (setq i (+ i 2))
  )
)

(defun c:cgb (/              b1      b2      b3      h1      h2      h3
              h4      bw      strlist wz      obj     objlist neirong
              neirong1              key     i              num     n              highlayer
              numbase basehigh              biaogao high0   highi   xz
              p1      pinsert layeri  lastlist
             )
                                        ;内部函数
  (defun writestring (p1 str xz / objlist)
    (command "text" "j" "mc" p1 0 str)
    (setq objlist (entget (entlast)))
    (setq objlist (subst (cons 8 "TEXT")
                         (assoc '8 objlist)
                         objlist
                  )
    )
    (setq objlist (subst (cons 40 300)
                         (assoc '40 objlist)
                         objlist
                  )
    )
    (entmod objlist)
    (setq xz (ssadd (entlast) xz))
  )
  (prompt "生成层高表")
  (vl-load-com)
  (setq oldstatus (dyq-get-oldstatus))
  (setvar "OSMODE" 0)
  (setvar "clayer" "DIM")
  (setq b1 800)                                ;层号列的列宽
  (setq b2 1300)                        ;标高列的列宽
  (setq b3 1100)                        ;层高列的列宽
  (setq h1 650)                                ;表格的竖向间距
  (setq h2 800)                                ;表格到"结构层楼面标高"垂直中的间距
  (setq h3 700)                                ;"结构层楼面标高"到"结  构  层  高"的中距
  (setq h4 500)                                ;"结  构  层  高"到底线的间距
  (setq bw1 50)                                ;粗线的线宽
  (setq bw 0)                                ;粗线的线宽
  (setq strlist (list "string"))        ;存储分割开后的文字内容
  (if (and (setq wz (entsel "\n请选择层高信息文字:"))
           (= (cdr (assoc '0 (entget (car wz)))) "TEXT")
      )
                                        ;增加判断文字类型机制
    (progn                                ;首先把按空格来区分
      (setq obj (car wz))
      (setq objlist (entget obj))
      (setq neirong (cdr (assoc '1 objlist))) ;文字内容
      (setq objlist (subst (cons 1 neirong) (assoc '1 objlist) objlist))
      (setq strlist (list "strlist"))
      (setq neirong1 neirong)
      (while (setq key (vl-string-search " " neirong1))
        (setq strlist (cons (substr neirong1 1 key) strlist))
        (setq neirong1 (substr neirong1 (+ key 2)))
      )
      (setq strlist (cons neirong1 strlist))
      (setq strlist (reverse strlist))
      (setq strlist1 (list "strlist1"))
      (setq i 1)
      (setq num (length strlist))
      (repeat (- num 1)
        (cond ((> (vl-string-search "X" (nth i strlist)) -1)
               (progn (setq key (vl-string-search "X" (nth i strlist)))
                      (setq n (atoi (substr (nth i strlist) (+ key 2))))
                      (setq highlayer (substr (nth i strlist) 1 key))
                      (repeat n
                        (setq strlist1 (cons highlayer strlist1))
                      )
               )
              )
              ((> (vl-string-search "x" (nth i strlist)) -1)
               (progn (setq key (vl-string-search "x" (nth i strlist)))
                      (setq n (atoi (substr (nth i strlist) (+ key 2))))
                      (setq highlayer (substr (nth i strlist) 1 key))
                      (repeat n
                        (setq strlist1 (cons highlayer strlist1))
                      )
               )
              )

              ((> (vl-string-search "*" (nth i strlist)) -1)
               (progn (setq key (vl-string-search "*" (nth i strlist)))
                      (setq n (atoi (substr (nth i strlist) (+ key 2))))
                      (setq highlayer (substr (nth i strlist) 1 key))
                      (repeat n
                        (setq strlist1 (cons highlayer strlist1))
                      )
               )
              )
              (T (setq strlist1 (cons (nth i strlist) strlist1)))
        )
        (setq i (+ i 1))
      )
      (setq strlist (reverse strlist1))
      (setq strlist1 nil)
      (if (and (setq numbase (getint "\n请输入地下室层数:"))
               (setq basehigh (getint "\n请输入建筑面层厚度(cm):"))
          )
        (progn                                ;生成各层标高
          (setq basehigh (/ basehigh -100.0))
          (setq n (- (length strlist) 1)) ;楼层层数
          (if (>= n numbase)
            (progn
              (setq i 1)
              (setq strlist1 (list "strlist1"))
              (repeat n
                (setq strlist1 (cons (atof (nth i strlist)) strlist1))
                (setq i (+ i 1))
              )
              (setq strlist1 (reverse strlist1)) ;层高记录表
                                        ;上部结构
              (setq biaogao (list (cons 0 "biaogao")))
              (setq biaogao (cons (cons 1 basehigh) biaogao))
              (setq i 2)
              (repeat (- n numbase)
                (setq high0 (cdr (assoc (- i 1) biaogao)))
                                        ;下一层的标高
                (setq highi (nth (+ i numbase -1) strlist1))
                                        ;下一层的层高
                (setq biaogao
                       (cons
                         (cons i (+ high0 highi))
                         biaogao
                       )
                )
                (setq i (+ i 1))
              )
                                        ;地下室

              (setq i -1)
              (repeat numbase
                (if (= i -1)
                  (setq high0 (cdr (assoc (+ i 2) biaogao)))
                                        ;负一层的标高
                  (setq high0 (cdr (assoc (+ i 1) biaogao)))
                                        ;上一层的标高
                )
                (setq highi (nth (+ i numbase 1) strlist1)) ;本层的层高
                (setq biaogao
                       (cons
                         (cons i (- high0 highi))
                         biaogao
                       )
                )
                (setq i (- i 1))
              )


              (setq xz (ssadd))                ;用来存储
              (if (setq pinsert (getpoint "\n请点取层高表插入点:"))
                (progn
                  (setq p1 pinsert)
                  (command "pline"
                           (polar p1 pi b1)
                           "w"
                           bw
                           bw
                           (polar p1 0 (+ b2 b3))
                           ""
                  )
                  (setq xz (ssadd (entlast) xz))
                  (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                  (writestring (polar p1 pi (* b1 0.5)) "层 号" xz)
                  (writestring (polar p1 0 (* b2 0.5)) "标高H(m)" xz)
                  (writestring
                    (polar p1 0 (+ b2 (* b3 0.5)))
                    "层高(m)"
                    xz
                  )
                  (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                  (command "pline"
                           (polar p1 pi b1)
                           "w"
                           bw
                           bw
                           (polar p1 0 (+ b2 b3))
                           ""
                  )
                  (setq xz (ssadd (entlast) xz))
                  (setq i 1)                ;地下室输出
                  (while (<= i numbase)
                    (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                    (setq layeri (- i numbase 1))
                    (writestring
                      (polar p1 pi (* b1 0.5))
                      (itoa layeri)
                      xz
                    )
                    (writestring
                      (polar p1 0 (* b2 0.5))
                      (rtos (cdr (assoc layeri biaogao)) 2 3)
                      xz
                    )
                    (writestring
                      (polar p1 0 (+ b2 (* b3 0.5)))
                      (rtos (nth i strlist1) 2 3)
                      xz
                    )
                    (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                    (command "line"
                             (polar p1 pi b1)
                             (polar p1 0 (+ b2 b3))
                             ""
                    )
                    (setq xz (ssadd (entlast) xz))
                    (setq i (+ i 1))
                  )
                  (setq i 1)                ;上部结构输出
                  (repeat (- n numbase)
                    (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                    (setq layeri i)
                    (writestring
                      (polar p1 pi (* b1 0.5))
                      (itoa layeri)
                      xz
                    )
                    (writestring
                      (polar p1 0 (* b2 0.5))
                      (rtos (cdr (assoc layeri biaogao)) 2 3)
                      xz
                    )
                    (writestring
                      (polar p1 0 (+ b2 (* b3 0.5)))
                      (rtos (nth (+ i numbase) strlist1) 2 3)
                      xz
                    )

                    (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                    (command "line"
                             (polar p1 pi b1)
                             (polar p1 0 (+ b2 b3))
                             ""
                    )
                    (setq xz (ssadd (entlast) xz))
                    (setq i (+ i 1))
                  )
                  (command "line"        ;输出屋面
                           (polar p1 pi b1)
                           (polar p1 0 (+ b2 b3))
                           ""
                  )
                  (setq xz (ssadd (entlast) xz))
                  (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                  (setq layeri i)
                  (writestring
                    (polar p1 pi (* b1 0.5))
                    "屋面"
                    xz
                  )
                  (writestring
                    (polar p1 0 (* b2 0.5))
                    (rtos (cdr (assoc layeri biaogao)) 2 3)
                    xz
                  )

                  (setq p1 (polar p1 (* pi 0.5) (* h1 0.5)))
                  (command "line" pinsert p1 "")
                  (setq xz (ssadd (entlast) xz))
                  (command "line"
                           (polar pinsert 0 b2)
                           (polar p1 0 b2)
                           ""
                  )
                  (setq xz (ssadd (entlast) xz))
                  (setq
                    p1 (polar pinsert 0 (- (* (+ b1 b2 b3) 0.5) b1))
                  )
                  (setq p1 (polar p1 (* pi -0.5) h2))
                  (writestring
                    p1
                    "结构层楼面标高"
                    xz
                  )

                  (setq lastlist (entget (entlast)))
                  (setq        lastlist (subst        (cons 40 500)
                                        (assoc '40 lastlist)
                                        lastlist
                                 )
                  )
                  (entmod lastlist)
                  (setq p1 (polar p1 (* pi -0.5) h3))
                  (writestring
                    p1
                    "结  构  层  高"
                    xz
                  )
                  (setq lastlist (entget (entlast)))
                  (setq        lastlist (subst        (cons 40 500)
                                        (assoc '40 lastlist)
                                        lastlist
                                 )
                  )
                  (entmod lastlist)
                  (setq p1 (polar p1 (* pi -0.5) h4))
                  (command "pline"
                           (polar p1 pi (* (+ b1 b2 b3) 0.5))
                           "w"
                           bw1
                           bw1
                           (polar p1 0 (* (+ b1 b2 b3) 0.5))
                           ""
                  )
                  (setq xz (ssadd (entlast) xz))
                )
              )
              (if (tblsearch "block" "C层高表")
                (command "block" "C层高表" "Y" pinsert xz "")
                (command "block" "C层高表" pinsert xz "")
              )
              (command "insert" "C层高表" pinsert 1 1 0)
            )
            (prompt "\n错误!地下室层数大于总层数，请检查!")
          )
        )
      )
    )
    (prompt "\n选择的对象不是文字，请重新执行命令!")
  )
  (dyq-put-oldstatus oldstatus)
  (princ)
)                                        ;cgb定义完成

szmax

可以参考.

tc405003

楼柱请检查一下，好像用不了，不知是不是少了什么子函数如writestring

qiaqiadeng

楼上的再试试

农民砼

:L不能用啊？不能用啊

杜流浪人

辛苦了          支持      

77077

顶起来看看~~~~