隧道断面绘制

tzfcn

;; sddm隧道断面绘制程序 ;; 雄鹰套改于2021-4-5
(defun c:sddm (/ ilst)
  (xyp-start)
  (defun main-pro (/ p0)
    (while (setq p0 (getpoint "\n中心基点<退出>: "))
      (xyp-Group0)
      (hzsddm p0 $r1 $r2 $r3 $r4 $h1 $h2)
      (xyp-Group1)
    )
  )
  (xyp-initSet
    '(k0 $r1 $r2 $r3 $r4 d1 $h1 $h2)
    '("0" 5700. 8200. 1000. 15000. 2500. 1610. 1600.)
  )
  (setq    ilst '(":row{"
    ("k0" "" "ib" "-2" "40" "sddm001" "(princ)")
    "spacer;"
    ("" "隧道参数" ":boxed_column{")
    ("$r1" "上半圆半径" "real" "10")
    ("$r2" "帮底圆半径" "real" "10")
    ("$r3" "底角圆半径" "real" "10")
    ("$r4" "底拱圆半径" "real" "10")
    ("$h1" "巷底上拱中高差" "real" "10")
    ("$h2" "巷底底拱中高差" "real" "10")
    "spacer;"
    "}"
    "}"
    )
  )
  (if (= (xyp-Dcl-Init Ilst "【隧道断面绘制】" t) 1)
    (main-pro)
  )
  (xyp-end)
)

xk15c

稍微介绍一下呀

janshyl

少了e派函數 有就更完善了 感謝樓主分享

aisong220

tzfcn

xk15c 发表于 2021-4-13 06:54
稍微介绍一下呀

不用花豆豆的代码，试用的好就用，觉得不好就不用，标题意义明确，不用赘述的。

tzfcn

janshyl 发表于 2021-4-13 07:50
少了e派函數 有就更完善了 感謝樓主分享

e派函数可以使代码更清晰，为什么不用？

tzfcn

;; sddm隧道断面绘制程序 ;; 雄鹰套改于2021-4-5
(defun c:sddm (/ ilst)
  (xyp-start)
  (defun main-pro (/ p0)
    (while (setq p0 (getpoint "\n中心基点<退出>: "))
      (xyp-Group0)
      (hzsddm p0 $r1 $r2 $r3 $r4 $h1 $h2)
      (xyp-Group1)
    )
  )
  (xyp-initSet
    '(k0 $r1 $r2 $r3 $r4 d1 $h1 $h2)
    '("0" 5700. 8200. 1000. 15000. 2500. 1610. 1600.)
  )
  (setq    ilst '(":row{"
    ("k0" "" "ib" "-2" "40" "sddm001" "(princ)")
    "spacer;"
    ("" "隧道参数" ":boxed_column{")
    ("$r1" "上半圆半径" "real" "10")
    ("$r2" "帮底圆半径" "real" "10")
    ("$r3" "底角圆半径" "real" "10")
    ("$r4" "底拱圆半径" "real" "10")
    ("$h1" "巷底上拱中高差" "real" "10")
    ("$h2" "巷底底拱中高差" "real" "10")
    "spacer;"
    "}"
    "}"
    )
  )
  (if (= (xyp-Dcl-Init Ilst "【隧道断面绘制】" t) 1)
    (main-pro)
  )
  (xyp-end)
)

;; hzsddm 隧道断面 (hzsddm p0 $r1 $r2 $r3 $r4 $h1 $h2)
(defun hzsddm (p0 $r1 $r2 $r3 $r4 $h1 $h2 / d1 o1 o1p1 o1p2 o2 o2a o2p1    o3 o3a o3p1 o3p2 o4 o4p2)
  (setq   
    o1   (xyp-Pt2Y p0 $h1)
    d1   (- $r2 $r1)
    o2   (xyp-Pt2X o1 (- d1))
    o2a  (xyp-Pt2X o1 d1)
    o4   (polar p0 (/ pi 2) (- $r4 $h2))
    o3a  (xyp-2Pt2Side o4 o2 (- $r4 $r3) (- $r2 $r3))
    o3   (xyp-2Pt2Side o2a o4 (- $r2 $r3) (- $r4 $r3))
    o1p1 (xyp-Pt2X o1 $r1) ;上半圆弧右起点
    o1p2 (xyp-Pt2X o1 (- $r1)) ;上半圆弧左终点
    o3p1 (polar o3 (+ pi (angle o3 o2a)) $r3) ;角拱上起点
    o3p2 (polar o3 (angle o4 o3) $r3) ;角拱下终点
    o4p2 (polar o3a (angle o4 o3a) $r3) ;底拱右终点
    o2p1 (polar o3a (angle o2 o3a) $r3) ;角拱上终点
  )
  (xyp-Arc-CPP o1 o1p1 o1p2) ;上半圆拱
  (xyp-Arc-CPP o2a o1p2 o3p1) ;左帮底弧
  (xyp-Arc-CPP o3 o3p1 o3p2) ;左底角弧
  (xyp-Arc-CPP o4 o3p2 o4p2) ;底拱
  (xyp-Arc-CPP o3a o4p2 o2p1) ;右底角拱
  (xyp-Arc-CPP o2 o2p1 o1p1) ;右底帮拱弧
)

tzfcn

没有办法，老是自作聪明的乱改代码

aisong220

楼主厉害

MUYIY