衡重式挡土墙,取自论坛

cjf160204

主程序有问题

cjf160204

(defun c:dtq ()
  (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)