三心拱绘制

nuic-ljsh

;;;三心拱设计模板20140117 v1.0

(vl-load-com)
(defun
          c:sxg
               ()
    (setq o-osmode (getvar "osmode"))
    (setvar "osmode" 0)
    (print "\n三心拱参数.")
    ;;巷道净宽度B0
    (setq b0 (getreal "\n输入巷道净宽度:"))
    (setq hg (getreal "\n输入巷道净高度:"))
    (setq d0 (getreal "\n巷道支护厚度:"))
    (setq sxglx 1)
    (prompt
        "三心拱类型[(1)1/3拱(2)1/4拱(3)1/5拱(4)1/2]<"
    )
    (princ sxglx)
    (prompt ">: ")
    (setq temp (getint))
    (if        temp
        ()
        (setq temp sxglx)
    )
    (if        temp
        (cond
            ((= temp 1)
             (setq f0 (/ b0 3.0))

             (setq str "1/3拱")
            )
            ((= temp 2)
             (setq f0 (/ b0 4.0))
             (setq str "1/4拱")
            )
            ((= temp 3)
             (setq f0 (/ b0 5.0))
             (setq str "1/5拱")
            )
            ((= temp 4)
             (setq f0 (/ b0 2.0))
             (setq str "1/2拱")
            )
            (t nil)
        )
    )
;;;    (setq h3 (getreal "\n拱形巷道墙高:"))
    (setq h3 (- hg f0))
    (setq xy (getxy f0 b0 temp))
    (setq ab (getab xy temp))

;;; 大小圆半径
    (setq brsr (getr f0 b0 xy temp))
    (setq br (car brsr)
          sr (cadr brsr)
    )
    ;;拱顶内弧长
    (setq gdn-hch (gethch brsr ab temp))
    ;;拱顶内净面积
    (setq gdn-jmj (getjmj brsr ab xy temp))
    (setq pt (getpoint "/n拱底部中心位置."))
    (setq textpt (polar pt (/ pi -2.0) 0.5))
;;;    (setq str1 (strcat str "净断面："))
    (setq str1 "净断面：")
    (setq
        area-nzh (draw-sxg pt b0 h3 f0 br sr str1 textpt gdn-jmj temp)
    )
    (setq zh (getstring "计算拱支护面积[Y/N]<N>"))
    (if        (= (strcase zh) "Y")
        (progn
            (setq b0 (+ b0 (* 2.0 d0))
                  f0 (+ f0 d0)
            )
            (setq xy (getxy f0 b0 temp))
            (setq ab (getab xy temp))
            (setq brsr (getr f0 b0 xy temp))
            (setq br (car brsr)
                  sr (cadr brsr)
            )
            ;;拱顶内弧长
            (setq gdn-hch (gethch brsr ab temp))
            ;;拱顶内净面积
            (setq gdn-jmj (getjmj brsr ab xy temp))
;;;            (setq str1 (strcat str "掘进面："))
            (setq str1 "掘进面：")
            (setq textpt (polar pt (/ pi -2.0) 0.8))
            (setq area-zh (draw-sxg pt           b0          h3         f0        br
                                    sr           str1          textpt gdn-jmj
                                    temp
                                   )
            )
            (setq zh (- area-zh area-nzh))
;;;            (setq str1 (strcat str "支护砼："))
            (setq str1 "支护砼：")
            (setq textpt (polar pt (/ pi -2.0) 1.1))
            (cmdtextBc textpt 0.2 0.0 (strcat str1 (rtos zh 2 3)))
        )
    )
    (setvar "osmode" o-osmode)
    (princ)
)

(defun
          getxy
               (f0 b0 temp / e1 e2 e3)
    (if        (/= temp 4)
        (progn

            (setq e1 (/ (* f0 (- b0 (* 2.0 f0))) (* 2.0 b0))
                  e2 (+ 1.0 (/ b0 (* 2.0 f0)))
                  e3 (/ b0 f0)
            )
            (setq x (* e1 (+ e2 (sqrt (- (* e2 e2) e3)))))
            (setq y (* (/ (- b0 (* 2.0 f0)) (* 8.0 f0))
                       (+ b0
                          (* 2.0 f0)
                          (sqrt (+ (* 4.0 f0 f0) (* b0 b0)))
                       )
                    )
            )
        )
        (setq x        (/ b0 2)
              y        0.0
        )
    )
    (list x y)
)
;;;计算角度α与β
(defun
          getab
               (xy temp / x y a b)
    (setq x (car xy)
          y (cadr xy)
    )
    (if        (= temp 4)
        (setq b        0.0
              a        90.0
        )
        (progn
            (setq b (atan y x))
            (setq a (- (/ pi 2.0) b))
        )
    )
    (list a b)
)
;;;求大小圆半径，如果为半圆拱，小半径等于净宽1/2.大圆半径为0.
(defun
          getr
              (f0 b0 xy temp /)
    (setq x (car xy)
          y (cadr xy)
    )
    (if        (= temp 4)
        (progn
            (setq br 0.0)
            (setq sr x)
        )
        (progn
            (setq sr (- (/ b0 2.0) x))
            (setq br (+ f0 y))
        )
    )
    (list br sr)
)


(defun
          gethch
                (brsr ab temp / br sr a b l)

    (setq br (car brsr)
          sr (cadr brsr)
    )
    (setq a (car ab)
          b (cadr ab)
    )
    (if        (= temp 4)
        (setq l (* pi sr))
        (setq l (* 2.0 (+ (* a br) (* b sr))))
    )
    l
)

(defun
          getjmj
                (brsr ab xy temp / br sr a b x y s)
    (setq br (car brsr)
          sr (cadr brsr)
    )
    (setq a (car ab)
          b (cadr ab)
    )
    (setq x (car xy)
          y (cadr xy)
    )
    (if        (= temp 4)
        (setq s (/ (* pi sr sr) 2.0))
        (setq s (- (+ (* a br br) (* b sr sr)) (* x y)))
    )
    s
)

(defun
          cmdtextBc
                   (pt texthh jiaodu text)
    (command
        "text" "j" "bc"        pt texthh jiaodu text "")
)

(defun
          draw-sxg
                  (pt         b0    h3    f0           br         sr    str1  textpt
                   gdn-jmj     temp  /           pt1         pt2   pt3   pt4
                   c0         c1    c2    c01   c02
                  )
    (if        (/= temp 4)
        (progn
            (setq pt1 (polar pt 0.0 (/ b0 2.0))
                  pt2 (polar pt pi (/ b0 2.0))
            )
;;;    (cmdtextBc pt1  20 0.0 "pt1")
            (setq pt3 (polar pt2 (/ pi 2.0) h3)
                  pt4 (polar pt1 (/ pi 2.0) h3)
            )
            (setq c1 (polar pt4 pi sr)
                  c2 (polar pt3 0.0 sr)
            )
            (setq c0 (polar pt (/ pi 2.0) (- (+ f0 h3) br)))
            (setq c01 (polar c0 (angle c0 c1) br)
                  c02 (polar c0 (angle c0 c2) br)
            )
            (setq ss2 (ssadd))
            (command "pline" pt4 pt1 pt2 pt3 "")
            (setq ent (entlast))
            (setq ss2 (ssadd ent ss2))
            (command "arc" "c" c0 c01 c02 "")
            (setq ent (entlast))
            (setq ss2 (ssadd ent ss2))
            (command "arc" "c" c1 pt4 c01 "")
            (setq ent (entlast))
            (setq ss2 (ssadd ent ss2))
            (command "arc" "c" c2 c02 pt3 "")
            (setq ent (entlast))
            (setq ss2 (ssadd ent ss2))
            (setq ent nil)
            (command "pedit" "m" ss2 "" "y" "j" 0.1 "")

            (setq area (+ gdn-jmj (* b0 h3)))
            (cmdtextBc textpt 0.2 0.0 (strcat str1 (rtos area 2 3)))
        )
        (progn
            (setq pt1 (polar pt 0.0 (/ b0 2.0))
                  pt2 (polar pt pi (/ b0 2.0))
            )

            (setq pt3 (polar pt2 (/ pi 2.0) h3)
                  pt4 (polar pt1 (/ pi 2.0) h3)
            )
            (setq c (polar pt3 0.0 sr))
            (setq ss2 (ssadd))
            (command "pline" pt4 pt1 pt2 pt3 "")
            (setq ent (entlast))
            (setq ss2 (ssadd ent ss2))
            (command "arc" "c" c pt4 pt3 "")
            (setq ent (entlast))
            (setq ss2 (ssadd ent ss2))
            (setq ent nil)
            (command "pedit" "m" ss2 "" "y" "j" 0.1 "")
            (setq area (+ gdn-jmj (* b0 h3)))
            (cmdtextBc textpt 0.2 0.0 (strcat str1 (rtos area 2 3)))
        )
    )
    area
)

newer

三星拱是什么样的？ 有图吗？

jwj0805

三心拱就是地下的一些采矿巷道工程，或者隧道工程

nuic-ljsh

nuic-ljsh

前两个为面积m2，最后为支护面积m2

WhoCanSay

开始没明白支护是什么意思，前天我平生第一次下井，洞中没支护

nuic-ljsh

图中标注可以自己加，希望对大家能有一点帮助。

nuic-ljsh

巷道围岩破碎时采取的措施，确保巷道安全稳定。支护大概有混凝土支护、喷射混凝土支护、锚杆支护、挂网支护、钢梁支护、U型钢支护以及混合支护等。

newer

nuic-ljsh 发表于 2016-6-2 21:08
巷道围岩破碎时采取的措施，确保巷道安全稳定。支护大概有混凝土支护、喷射混凝土支护、锚杆支护、挂网支护 ...

看图明白了，是三个圆心的拱组合啊，这样的结构适合井下吗？ 结构稳定？ 还是什么？

nuic-ljsh

;;批量提取圆心坐标并存入文件中

1. (prompt "获取点集合：getptset")
   
2. (defun c:getptset ()
   
3.     (setq ss1 nil)
   
4.     (setq fname
   
5.        (getfiled
   
6.      "Select a Lisp File"
   
7.      "c:/program files/ <AutoCAD installation directory>/support/"
   
8.      "txt"
   
9.      1
   
10.        )
    
11.     )
    
12.     (setq out (open fname "w"))
    
13.     (setq pt1 (getpoint "请选择点集一角:")
    
14.     pt2 (getcorner pt1 "指定另一对角点:")
    
15.     )
    
16.     (setq ss1 (ssget "C" pt1 pt2))
    
17.     (setq ssLen  (sslength ss1)
    
18.     i  0
    
19.     )
    
20.     (while (< i sslen)
    
21.   (setq a (ssname ss1 i))
    
22.   (if (= (cdr (assoc 0 (entget a))) "CIRCLE")
    
23.       (progn
    
24.     (setq pt (cdr (assoc 10 (entget a))))
    
25.     (setq x  (car pt)
    
26.           y  (cadr pt)
    
27.           z  (caddr pt)
    
28.     )
    
29.     (print x out)
    
30.     (princ "   " out)
    
31.     (princ y out)
    
32.     (princ "   " out)
    
33.     (princ z out)
    
34. ;;;    (setq line (strcat (rtos x 2 3)
    
35. ;;;           "        "
    
36. ;;;           (rtos y 2 3)
    
37. ;;;           "        "
    
38. ;;;           (rtos z 2 3)
    
39. ;;;         )
    
40. ;;;    )
    
41. ;;;    (print line out)
    
42.       )
    
43.   )
    
44.   (setq i (1+ i))
    
45.     )
    
46.     (close out)
    
47. )

(prompt "获取点集合：getptset")<br /> (defun c:getptset ()<br />     (setq ss1 nil)<br />     (setq fname<br />        (getfiled<br />      "Select a Lisp File"<br />      "c:/program files/ <AutoCAD installation directory>/support/"<br />      "txt"<br />      1<br />        )<br />     )<br />     (setq out (open fname "w"))<br />     (setq pt1 (getpoint "请选择点集一角:")<br />     pt2 (getcorner pt1 "指定另一对角点:")<br />     )<br />     (setq ss1 (ssget "C" pt1 pt2))<br />     (setq ssLen  (sslength ss1)<br />     i  0<br />     )<br />     (while (< i sslen)<br />   (setq a (ssname ss1 i))<br />   (if (= (cdr (assoc 0 (entget a))) "CIRCLE")<br />       (progn<br />     (setq pt (cdr (assoc 10 (entget a))))<br />     (setq x  (car pt)<br />           y  (cadr pt)<br />           z  (caddr pt)<br />     )<br />     (print x out)<br />     (princ "   " out)<br />     (princ y out)<br />     (princ "   " out)<br />     (princ z out)<br /> ;;;    (setq line (strcat (rtos x 2 3)<br /> ;;;           "        "<br /> ;;;           (rtos y 2 3)<br /> ;;;           "        "<br /> ;;;           (rtos z 2 3)<br /> ;;;         )<br /> ;;;    )<br /> ;;;    (print line out)<br />       )<br />   )<br />   (setq i (1+ i))<br />     )<br />     (close out)<br /> )

newer

nuic-ljsh 发表于 2016-6-2 21:26
;;批量提取圆心坐标并存入文件中

不同于主题的帖子还是另外开贴贴代码吧。

nuic-ljsh

newer 发表于 2016-6-2 21:20
看图明白了，是三个圆心的拱组合啊，这样的结构适合井下吗？ 结构稳定？ 还是什么？

三心拱特点：

任意三心拱，是指三心拱的拱宽和拱高可以任意指定，但拱形本身必须具备下列特点：

1.拱作为受力结构的主要特性，是要将覆在其上的载荷作用所产生的内应力，沿拱上任意点的切线方向传递至拱（或墙脚），而拱上任意点的径向应力（拉或压应力）为0，这在理论上就必须要求拱的三段圆弧上的任意点的切线均应垂直通过该点的圆弧半径，包括大小三段弧相切之切点的切线必须垂直大小圆弧半径的重合点。不具备这一特性，则不是一个标准的拱形。一心拱即半圆拱和弧形拱具备这一特性，仅是三心拱的特例。

2.大拱的顶部圆弧之圆心在拱的对称轴线上，而两侧小圆弧之圆心的联线被对称轴线垂直平分。

3.拱之大小圆弧相内切，通过其切点的切线垂直大小圆弧半径之重合线。

拱顶三段弧连接点处是光滑的（有公共切线），适合井下巷道断面。

vicwjb

这是同行吗？看到三心拱。。。

xvjiex

感谢楼主分享三心拱绘制