(vl-load-com)
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
;; 获取用户输入的参数
(setq h-dtq (getreal "\n输入墙高 (m) <6.0>: ") h-dtq (if h-dtq h-dtq 6.0))
(setq b-dtq (getreal "\n输入墙顶宽 (m) <0.75>: ") b-dtq (if b-dtq b-dtq 0.75))
(setq h1-dtq (getreal "\n输入一阶高度 (m) <2.8>: ") h1-dtq (if h1-dtq h1-dtq 2.8))
(setq platform-width (getreal "\n输入衡重台宽度 (m) <1.0>: ") platform-width (if platform-width platform-width 1.0))
(setq m2-dtq-top (getreal "\n输入墙背坡度上部 (1:m) <0.35>: ") m2-dtq-top (if m2-dtq-top m2-dtq-top 0.35))
(setq m2-dtq-bot (getreal "\n输入墙背坡度下部 (1:m) <0.25>: ") m2-dtq-bot (if m2-dtq-bot m2-dtq-bot 0.25))
(setq n-dtq (getreal "\n输入底边坡度 (n:1) <0.1>: ") n-dtq (if n-dtq n-dtq 0.1))
(setq bot-dtq (getreal "\n输入墙底宽 (m) <2.91>: ") bot-dtq (if bot-dtq bot-dtq 2.91))
(setq hj (getreal "\n输入墙趾高 (m) <1.0>: ") hj (if hj hj 1.0))
(setq face-slope (getreal "\n输入面坡 (1:m) <0.1>: ") face-slope (if face-slope face-slope 0.1))
;; 获取插入点
(setq p1 (getpoint "\n拾取插入点(挡土墙左上角): "))
(if p1
(progn
;; 计算各点坐标
(setq p2 (polar p1 0 b-dtq)); 墙顶右侧点
(setq p2-yy h1-dtq)
(setq p2-xx (* p2-yy m2-dtq-top))
(setq p21 (list (+ (car p2) p2-xx) (- (cadr p2) p2-yy))); 墙背坡度上部转折点
(setq p22 (polar p21 0 platform-width)); 衡重台右侧点
(setq p22-yy (- h-dtq h1-dtq))
(setq p22-xx (* p22-yy m2-dtq-bot))
(setq p3 (list (- (car p22) p22-xx) (- (cadr p22) p22-yy))); 墙背坡度下部转折点
(setq p3-xx bot-dtq)
(setq p3-yy (* p3-xx n-dtq))
(setq p4 (list (- (car p3) p3-xx) (+ (cadr p3) p3-yy))); 墙底左侧点
(setq p1-yy (- h-dtq hj p3-yy))
(setq p1-xx (* p1-yy face-slope))
(setq p6 (list (- (car p1) p1-xx) (- (cadr p1) p1-yy))); 墙趾左侧点
(setq p5 (polar p4 (* pi 0.5) hj)); 墙趾右侧点
;; 绘制挡土墙
(command "pline" p1 p2 p21 p22 p3 p4 p5 p6 "c")
;; 标注坡比
(setq str1 (strcat "1:" (rtos face-slope 2 2)))
(setq ang (angle p6 p1))
(setq pm (polar (mid-2pt p1 p6) (+ ang (* 0.5 pi)) 0.3))
(MkText "C" pm 0.25 (xd-rtd ang) str1 0.7)
(setq str2 (strcat "1:" (rtos m2-dtq-top 2 2)))
(setq ang (angle p2 p21))
(setq pm (polar (mid-2pt p2 p21) (+ ang (* 0.5 pi)) 0.3))
(MkText "C" pm 0.25 (xd-rtd ang) str2 0.7)
(setq str3 (strcat "1:" (rtos m2-dtq-bot 2 2)))
(setq ang (angle p22 p3))
(setq pm (polar (mid-2pt p22 p3) (+ ang (* 0.5 pi)) 0.3))
(MkText "C" pm 0.25 (xd-rtd ang) str3 0.7)
(setq str4 (strcat (rtos n-dtq 2 2) ":1"))
(setq ang (angle p4 p3))
(setq pm (polar (mid-2pt p3 p4) (+ ang (* 0.5 pi)) 0.3))
(MkText "C" pm 0.25 (xd-rtd ang) str4 0.7)
)
)
;; 恢复 OS 模式
(setvar "osmode" os)
(princ)
)
;; 辅助函数
(defun Mid-2pt (P1 P2 / X1 X2) (Mapcar '(Lambda (X1 X2) (/ (+ X1 X2) 2)) P1 P2))
(defun xd-rtd (j$) (/ (* j$ 180.0) pi))
;; 轻量级创建文字
(defun MkText (duiqi pt zg ang text zk / p1 p2 y1 y2 wzys)
(setq wzys (MakeWzys "Tssd_Hz" 30 0.8))
(setq duiqi (strcase duiqi nil))
(cond
((= duiqi "M") (setq y1 '(72 . 4)) (setq y2 '(73 . 0))) ; 中中
((= duiqi "C") (setq y1 '(72 . 1)) (setq y2 '(73 . 0))) ; 中下
)
(setq ang (* pi (/ ang 180.0)))
(entmakex
(append
(list '(0 . "TEXT") (cons 1 text) (cons 10 pt))
(list (cons 11 pt) (cons 40 zg) (cons 41 zk) '(71 . 0))
(list y1 y2 (cons 50 ang) (cons 7 wzys))
)
)
)
;; 创建文字样式
(defun MakeWzys (Wzys zg zk / lst zt1 zt2 zt)
(setq lst (list "tssdeng.shx" "hztxt.shx"))
(if (vl-every 'findfile lst)
(mapcar 'set '(zt1 zt2) lst)
(setq zt (tblsearch "style" "Standard")
zt1 (dxf 3 zt)
zt2 (dxf 4 zt)
)
)
(if (Not (Tblsearch "Style" Wzys))
(entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") '(70 . 0) (cons 2 wzys) (cons 40 zg) (cons 41 zk) (cons 3 zt1) (cons 4 zt2)))
(Setvar "textstyle" wzys)
)
wzys
)
(princ "\n衡重式挡土墙绘制命令加载完成。输入 dtq 开始绘制。")
(princ) 技术强大学习了
页:
1
[2]