[编程申请]：能否把楼梯建筑剖面图程序改为结构剖面配筋图

zhjy

能否把楼梯建筑剖面图程序改为结构剖面配筋图
附:楼梯建筑剖面图程序
code:

;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;@                    楼梯剖面软件                         @
;@                     Ver: 1.0                            @
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

(defun *error*(st)
  (if (and (/= st "Function cancelled")
           (/= st "quit / exit abort")
      )
      (princ (strcat "错误: " st))
  )
  (setq *error* old_err)
  (princ)
)

(defun C:ltpm( / old_err loop pt tb1 tb2 tbk tbg tbh dis dish test lg ll lk
                 pt0 ss pt1 pt2 ptt1 ptt2 ptt3 ptt4 pt00 a ptt llg
                 p1 p2 p3 p4 p5 p6 p7 ang pp1 pp2)
  (setq old_err *error*)
  (setvar "CMDECHO" 0)
  (command "layer" "m" "lt" "c" "y" "lt" "")
  (princ "\n  --欢迎使用楼梯剖面软件--  Ver: 1.0 ")
  (setvar "osmode" 512)
  (setq loop T)
  (while loop
    (initget 1 "R")
    (setq pt (getpoint "\nR参照点/<点取楼梯间地面起点(缺省nea方式)>: "))
    (cond
      ((eq pt "R") (progn
                     (command "osnap" "int")
                     (setq pt (getpoint "\n参照点(缺省int方式): "))
                     (setq pt (getpoint pt "\n相对坐标(格式:@X,Y或@长度<角度): "))
                     (setq loop nil)
                    ))
      (t (setq loop nil))
    )
  )
  (setvar "osmode" 0)

  (setq tb1 (getint "\n第一跑踏步数(竖向)<9>: "))
  (if (null tb1) (setq tb1 9))
  (setq tb2 (getint "\n第二跑踏步数(竖向)<9>: "))
  (if (null tb2) (setq tb2 9))
  (setq tbk (getreal "\n踏步宽<260>: "))
  (if (null tbk) (setq tbk 260.0))
  (setq tbg (getreal "\n踏步高<165>: "))
  (if (null tbg) (setq tbg 165.0))
  (setq tbh (getreal "\n梯段板厚<100>: "))
  (if (null tbh) (setq tbh 100.0))
  (setq dis (getreal "\n休息平台宽<1200>"))
  (if (null dis) (setq dis 1200.0))
  (setq dish (getreal "\n休息平台厚<80>"))
  (if (null dish) (setq dish 80.0))
  (setq test T ang (atan tbg tbk))
  (while test
    (setq lg (getreal "\n休息平台梁高<350>"))
    (if (null lg) (setq lg 350.0))
    (setq ll (/ tbh (cos ang)))
    (if (< lg (+ ll tbg))
      (progn
        (princ "\n警告: 休息平台梁低于梯段板 !!!")
        (setq test T)
      )
      (setq test nil)
    )
  )
  (setq lk (getreal "\n休息平台梁宽<200>"))
  (if (null lk) (setq lk 200.0))
  (setq llg (getreal "\n楼梯栏杆<1000>"))
  (if (null llg) (setq llg 1000.0))
  (initget "Y N")
  (setq tt (getkword "\n第一跑是否涂黑 No/<Yes>: "))
  (setq pt0 pt test T)
  (setq ss (ssadd))

;   画第一跑
  (setq ptt1 (polar pt 0 (/ tbh (sin ang))))
  (command "line" pt0 ptt1 "")
  (setq ss (ssadd (entlast) ss))
  (repeat (- tb1 1)
    (setq pt1 (polar pt0 (* pi 0.5) tbg))
    (setq pt2 (polar pt1 0 tbk))
    (command "pline" pt0 "w" "0" "0" pt1 pt2  "") (setq ss (ssadd (entlast) ss))

;   楼梯栏杆
    (setq a (- llg (/ 60.0 (cos ang))))
    (setq b (* (/ tbk 4.0) (/ (sin ang) (cos ang))))
    (setq pl (polar pt1 0 (* tbk 0.25)))
    (setq p1 (polar pl (* pi 0.5) (- a b)))
    (if test (setq pp1 (polar p1 (+ ang pi) (/ 100.0 (cos ang)))))(setq test nil)
    (command "line" pl p1 "")
    (setq ss (ssadd (entlast) ss))
    (setq pl (polar pt1 0 (* tbk 0.75)))
    (setq p1 (polar pl (* pi 0.5) (+ a b)))
    (command "line" pl p1 "")
    (setq ss (ssadd (entlast) ss))

    (if (or (= tt "Y") (= tt nil))  ; 梯板涂黑
      (progn
        (command "layer" "m" "lt1" "c" "4" "lt1" "")
        (command "solid" pt1 pt2 (polar pt0 (* pi 1.5) ll) (polar pt2 (* pi 1.5) ll) "")
        (setq ss (ssadd (entlast) ss))
        (command "layer" "m" "lt" "c" "y" "lt" "")
      )
    )

    (setq pt0 pt2)
  )
  (setq ptt2 (polar pt0 (* pi 1.5) ll))
  (command "line" ptt1 ptt2 "")
  (setq ss (ssadd (entlast) ss))
  (setq p1 (polar pp1 (* pi 0.5) (/ 60.0 (cos ang))))
  (command "line" pp1 p1 "") (setq ss (ssadd (entlast) ss))


;   画休息平台
  (setq pt0 (polar pt0 (* pi 0.5) tbg))
  (setq p1 (polar pt0 0 dis))
  (command "line" pt0 p1 "") (setq ss (ssadd (entlast) ss))
  (setq p2 (polar pt0 (* pi 1.5) lg))
  (command "line" pt0 p2 "") (setq ss (ssadd (entlast) ss))
  (setq p3 (polar p2 0 lk))
  (command "line" p2 p3 "") (setq ss (ssadd (entlast) ss))
  (setq p4 (polar p3 (* pi 0.5) (- lg dish)))
  (command "line" p3 p4 "") (setq ss (ssadd (entlast) ss))
  (setq p5 (polar p4 0 (- dis lk lk)))
  (command "line" p4 p5 "") (setq ss (ssadd (entlast) ss))
  (setq p6 (polar p5 (* pi 1.5) (- lg dish)))
  (command "line" p5 p6 "") (setq ss (ssadd (entlast) ss))
  (setq p7 (polar p6 0 lk))
  (command "line" p6 p7 "") (setq ss (ssadd (entlast) ss))
  (command "line" p7 p1 "") (setq ss (ssadd (entlast) ss))
  (command "layer" "m" "lt1" "c" "4" "lt1" "")
  (command "solid" pt0 p1 p4 p5 "") (setq ss (ssadd (entlast) ss))
  (command "solid" pt0 p2 p4 p3 "") (setq ss (ssadd (entlast) ss))
  (command "solid" p1 p5 p7 p6 "") (setq ss (ssadd (entlast) ss))
  (command "layer" "m" "lt" "c" "y" "lt" "")

;   画扶手
  (setq p1 (polar pt0 0 (* tbk 0.25)))
  (setq p2 (polar p1 (* pi 0.5) (- a b)))
  (command "line" p1 p2 "") (setq ss (ssadd (entlast) ss))  ;画休息平台上的栏杆
  (setq p3 (polar pp1 ang (/ (+ 130 (* tbk (1- tb1))) (cos ang))))
  (command "line" pp1 p3 "") (setq ss (ssadd (entlast) ss))
  (setq pp2 (polar pp1 (* pi 0.5) (/ 60.0 (cos ang))))
  (setq p4 (polar pp2 ang (/ (+ 70 (* tbk (1- tb1))) (cos ang))))
  (command "line" pp2 p4 "") (setq ss (ssadd (entlast) ss))

;   画第二跑
  (setq ptt3 (polar pt0 (* pi 1.5) ll))
  (setq test T)
  (repeat tb2
    (setq pt1 (polar pt0 (* pi 0.5) tbg))
    (setq pt2 (polar pt1 (* pi 1) tbk))
    (command "pline" pt0 "w" "0" "0" pt1 pt2  "")
    (setq ss (ssadd (entlast) ss))

;   楼梯栏杆
    (setq pl (polar pt1 pi (* tbk 0.25)))
    (setq p1 (polar pl (* pi 0.5) (- a b)))
    (command "line" pl p1 "")
    (setq ss (ssadd (entlast) ss))
    (if test
      (progn
        (setq pp2 p1)
        (setq pp1 (polar p1 (- 0 ang) (/ (- (* tbk 0.5) 30) (cos ang))))
        (setq test nil)
      )
    )
    (setq pl (polar pt1 pi (* tbk 0.75)))
    (setq p1 (polar pl (* pi 0.5) (+ a b)))
    (command "line" pl p1 "")
    (setq ss (ssadd (entlast) ss))

    (if (= tt "N")     ; 梯板涂黑
      (progn
        (command "layer" "m" "lt1" "c" "4" "lt1" "")
        (command "solid" pt1 pt2 (polar pt0 (* pi 1.5) ll) (polar pt2 (* pi 1.5) ll) "")
        (setq ss (ssadd (entlast) ss))
        (command "layer" "m" "lt" "c" "y" "lt" "")
      )
    )

    (setq pt0 pt2)
  )
  (setq ptt4 (polar pt0 (* pi 1.5) ll))
  (command "line" ptt3 ptt4 "")
  (setq ss (ssadd (entlast) ss))
  (command "line" pt0 ptt4 "")
  (setq ss (ssadd (entlast) ss))

;   画扶手
  (command "line" pp1 p4 "") (setq ss (ssadd (entlast) ss))
  (command "line" pp1 p1 "") (setq ss (ssadd (entlast) ss))
  (setq pp2 (polar pp2 (* pi 0.5) (/ 60.0 (cos ang))))
  (setq pp2 (polar pp2 (- 0 ang) (/ (+ (* tbk 0.5) 30) (cos ang))))
  (command "line" pp2 p3 "") (setq ss (ssadd (entlast) ss))
  (command "line" pp2 (polar p1 (* pi 0.5) (/ 60 (cos ang))) "") (setq ss (ssadd (entlast) ss))

;   画完处理
  (setq a (getstring "\nY移动/<N>: "))
  (if (/= a "")
    (progn
      (setq ptt (getpoint pt "\n另一点: "))
      (command "move" ss "" pt ptt)
    )
  )
  (redraw)(princ)
)

XDSoft

jy,结构论坛和PKPM论坛置顶帖子，有朋友提供过绘制楼梯的程序，功能很好的，去看看。

青马

真是好懒啊,呵呵