画巷道拱断面图

tzfcn

;; xddm(巷道断面)
(defun c:xddm (/ ilst lst0 lst1 lst2)
  (xyp-Start)
  (defun main-pro (/ p1 k)
    (while (setq p1 (getpoint "\n基点<退出>: "));精华
      (xyp-Group0);建组命令，无参数。一般与(xyp-Group1)成对使用，放在图形绘制的头部。(xyp-Group1)放在尾部。这一对函数之间绘制的图形被组合成一组内容，相当于一个集合。
      (setq k (nth (atoi po1) lst2))
      (cond
        ((= li1 "0") (pdg p1 b h k));平底拱
        ((= li1 "1") (mtx p1 b h));马蹄拱
        ((= li1 "2") (txg p1 b h d));梯形断面
        (t nil)
      )
      (xyp-Group1)
    )
  )
  (defun ali1 ()
    (xyp-Dcl-Gettile '("li1"))
    (cond
      (;平底拱参数
        (member li1 '("0"));平底拱
        (mode_tile "po1" 0)
        (mode_tile "k0" 1)
        (mode_tile "b" 0)
        (mode_tile "h" 0)
        (mode_tile "k" 0)
        (mode_tile "d" 1)
        )

      (;马蹄拱
        (member li1 '("1"))  ;马蹄拱        
        (mode_tile "k0" 1)
        (mode_tile "po1" 1)
        (mode_tile "b" 0)
        (mode_tile "h" 0)
        (mode_tile "k" 1)
        (mode_tile "d" 1)
        ;(xyp-DynamicHatch "b" "h" "p1" "1" "mtx" "line")
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\mtg")
      )
      (;梯形拱
        (member li1 '("2"))   ;梯形断面
        (mode_tile "k0" 1)
        (mode_tile "po1" 1)
        (mode_tile "b" 0)
        (mode_tile "h" 0)
        (mode_tile "k" 1)
        (mode_tile "d" 0)
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\tx")
      )

    )
  )
  (defun ali2()
    (xyp-Dcl-Gettile '("po1"))
    (cond
      ((member po1 '("0"))
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\12拱"))
      ((member po1 '("1"))
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\13拱"))
      ((member po1 '("2"))
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\14拱"))
      ((member po1 '("3"))
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\25拱"))
      ((member po1 '("4"))
        (xyp-Show-Sld "k0" "D:\\我的文档\\1幻灯片\\15拱"))
    )  
  )

  (xyp-initSet
    '(li1 b h k d po1)
    '("0" 3000 3000 (/ 1 3.) 3000 "0")
  )
  (setq  
    lst0 '("平底拱" "马蹄拱" "梯形")
    lst1 '("1/2" "1/3" "1/4" "2/5" "1/5")
    lst2 (list 0.5 (/ 1 3.) 0.25 0.4 0.2)
    ilst '(":row{"
            ("k0" "" "ib" "-2" "40" "" "(princ)");-0黑底-1白底-2黑底-3蓝底-4白底-5灰底-6白底-7红底-8灰底-9白底-10兰
            "spacer;"
            ("li1" "断面" "list" "lst0" "7" "5" "(ali1)")
            ("" "巷道参数" ":boxed_column{")
            ("po1" "高/宽:K" "poplist" "lst1" "5" "(ali2)")
            ("b" "底宽:B" "int" "6");int,real,str
            ("h" "全高:H" "int" "6")
            ("d" "顶宽:d" "int" "6")
            "spacer;"
            "}"
            "}"
            ("" "" "user" "(ali1)")
          )
  )
  (if (= (xyp-Dcl-Init Ilst "【巷道断面绘制】" t) 1)
    (main-pro)
  )
  (xyp-End)
)


[sell=30];; txg(梯形拱)b1 2800 b2 3000 h3000
(defun txg (bpt b1 h b2 / p0 p1 p2 p3 lst1 lst2)
  (setq  
    p0   (polar (polar bpt (/ pi 2.) h) pi (/ b2 2.)) ;左上角点
    p1   (polar p0 0 b2)    ;右上角点
    p2   (polar bpt 0 (/ b1 2.))  ;右下角点
    p3   (polar p2 pi b1)    ;左下角点
    lst1 (list p0 p1 p2 p3)
    lst2 (list p1 p2 p3 p0)
  )
  (xyp-line lst1 lst2)
)

;; mtx(马蹄形) b 3000 h 3000 k0.333
(defun mtx (bpt  b h /  h0 baspt ang0 ang1 angs  angd dr  sr p1 p2 p3 o1 o2 o3)
  (setq  
    p0 (polar (polar bpt (/ pi 2.) h) pi (/ b 2.)) ;左上角点
    p1 (polar p0 0 b)    ;右上角点
    p2 (polar p1 (* pi 1.5) h)  ;右下角点
    p3 (polar p0 (* pi 1.5) h)  ;左下角点
    o1 (polar p2 (/ pi 2.) (/ h 2.)) ;左弧的圆心
    o2 (polar o1 pi b)    ;右弧的圆心
    o3 (polar (polar p0 0 (/ b 2.)) (* pi 1.5) (/ h 4.)) ;顶底弧的圆心
    r1 (sqrt (+ (* b b) (* h h 0.25))) ;腰弧半径
    r2 (/ r1 2.)      ;顶弧半径
    r3 (sqrt (+ (* b b 0.25) (* h h (/ (* 3 3.) (* 4 4.))))) ;底弧半径
  )          ;以下开始画拱线
  (xyp-Arc-CPP o3 p1 p0)    ;顶弧
  (xyp-Arc-CPP o1 p0 p3)    ;左腰弧
  (xyp-Arc-CPP o3 p3 p2)    ;底弧
  (xyp-Arc-CPP o2 p2 p1)    ;右腰弧
)

;; pdg(平底拱) b 3000 h 3000 k 1/3
(defun pdg (bpt  b h k /  h0 baspt ang0 ang1 angs  angd dr  sr p1 p2 p3 o1 o2 o3)
  (setq  h0    (- h (* k b))
    baspt (polar (polar bpt pi (/ b 2.)) (/ pi 2.) h0)
    ang0  (atan (/ 1. (* 2. k)))  ;顶内角
    ang1  (atan (* 2. k))    ;底内角
    angs  (- pi (* ang1 2.) ang0)  ;小圆心角
    angd  (- pi (* angs 2.))  ;计算大圆心角;
    x     (/ (sqrt (+ (* b b k k) (* b b 0.25)))
            (+ (/ (cos (/ ang0 2.)) (sin (/ ang0 2.)))
              (/ (cos (/ ang1 2.)) (sin (/ ang1 2.)))
            )
          )        ;右交点到弦
    y     (/ x
            (/ (sin (/ ang0 2.)) (cos (/ ang0 2.)))
            (/ (sin ang1) (cos ang1))
          )        ;拱顶中到共线
    z     (* (/ x (/ (sin (/ ang0 2.)) (cos (/ ang0 2.))))
            (/ (sin ang1) (cos ang1))
          )        ;小圆心到弦
    sr    (+ x z)      ;小圆弧半径
    dr    (/ (/ x (/ (sin (/ ang1 2.)) (cos (/ ang1 2.))))
            (sin (/ angd 2.))
          )        ;大圆弧半径
    ;计算关键点坐标
    p1    (polar baspt 0 b)    ;右起拱点
    o1    (polar baspt 0 (- b sr))  ;右小圆圆心
    p2    (polar o1 (/ angs 2.) sr)  ;右小弧中
    p3    (polar o1 angs sr)  ;右弧交点
    o2    (polar o1 (+ pi angs) (- dr sr)) ;大圆圆心
    p4    (polar (polar baspt 0 (/ b 2.)) (/ pi 2.) (* b k)) ;拱顶坐标
    p5    (polar o2 (+ (/ pi 2.) (/ angd 2.)) dr) ;左弧交点
    o3    (polar baspt 0 sr)  ;左小圆心
    p6    (polar o3 (- pi (/ angs 2.)) sr) ;左小弧中点
  )          ;以下开始画拱线
  (xyp-Arc-3pt p1 p2 p3)    ;右小弧
  (xyp-Arc-3pt p3 p4 p5)    ;大弧
  (xyp-Arc-3pt p5 p6 baspt)    ;左小弧
  (setq  
    p7    (polar p1 (* pi 1.5) h0)
    p8    (polar baspt (* pi 1.5) h0)
    list1 (list p1 p7 p8)
    list2 (list p7 p8 baspt)
  )
  (xyp-line list1 list2)
)[/sell]

需要事先安装e派工具箱和补丁。下载位置：QQ群：24942984中的共享文件内。

wd6688

这个要看看啊，学习学习啊！

longer1000

学习学习啊！

yjch

好好学习天天向上

zhangq_cai1

把xyp的函数补上就完美了~~~~~~~~~~~~~

sachindkini

see the hidden contents

tzfcn

sachindkini 发表于 2016-11-25 17:37

If you are interested, you can pay to view.

newer

tzfcn 发表于 2016-11-25 20:43

老外精着尼，他意思就是要看隐藏的内容。

jerry8019

tzfcn

newer 发表于 2016-11-25 21:02

看来老外也有想用免费的

kqqt6236

伪原码？      

tzfcn

kqqt6236 发表于 2017-2-25 00:07

是的，站在巨人的肩膀上才能看的更远。

tzfcn

kqqt6236 发表于 2017-2-25 00:07

是的。是伪原码

xinxirong

jjjjhvvvghhhhhuii