[分享]：立剖面标高程序（免币）

xyp1964

[php]
立剖面标高程序。
将压缩文件下载解压后，放到Acad搜索路径下，加载dtbg(动态标高).fas，运行dtbg。
功能：
1. 立面图、剖面图中先确定±0.000基点，然后点取要标注标高的点，自动生成标高，左右方向标高均可。
2. 剖面图楼层标高标注：先确定±0.000基点，然后输入层高、层数，自动在各楼层生成标高。
[/php]

xyp1964

程序示意：

LIFUPING

说说有什么功能？

xyp1964

功能介绍在一楼！

juan520

呵呵。这样方便多了
谢谢

whcdy

其中的.FAS文件是否也要放到ACAD的搜索路径中？

xyp1964

.FAS是程序文件，呵呵……

xmchy

r14下好像不能用,出现Command: lpmbg

错误: null function
nil*Cancel*
的文字.

sjm

Good !

szcoolcat

14中用不了呀,真是可惜.

xyp1964

提供源文件，供R14测试。
[php]
;|
LPMBG.lsp 立剖面标高
* C:LPMBG
-- XYP@bsedi.com
2004.11.14
|;
(prompt "\n\r      加载立剖面标高程序。")
;;;-------------------------------------------
;;;主程序
(DEFUN C:LPMBG (/ pt1 x x1 dy)
  (CMDLA0)
  (command ".undo" "BE")
  (MKLA "biaogao" 3)  
  (setq        txt5 (@ukword 1 "1 2 3 4 5" "\n请选择形式：1-右标高/2-左标高/3-剖面标高/4-设出图比例/5-设±0.000基点" txt5))
  (while (or (= txt5 "5")(NULL PT0))(@jidian)
    (setq txt5 (@ukword 1 "1 2 3 4 5" "\n请选择形式：1-右标高/2-左标高/3-剖面标高/4-设出图比例/5-设±0.000基点" txt5))
    )
  (while (or (= txt5 "4")(NULL SC))(@setbl1)
    (setq txt5 (@ukword 1 "1 2 3 4 5" "\n请选择形式：1-右标高/2-左标高/3-剖面标高/4-设出图比例/5-设±0.000基点" txt5))
    )
  (if (= txt5 "3")(@sec))
  (if (or (= txt5"1")(= txt5"2"))
    (progn
      (while
    (SETQ pt1 (getpoint pt0 "\n\t标高位置点<退出> : "))
    (setq x (- (cadr pt1) (cadr pt0))
          x1 (* (/ x 1000) (GETVAR "DIMLFAC"))
          dy (rtos x1 2 3)
           )
    (if (= txt5 "2")(@bgleft))
    (if (= txt5 "1")(@bgright))
    )))
  (command ".undo" "E")
  (CMDLA1)
)
;;;-------------------------------------------
;;;子程序
;;;±0.000基点
(defun @jidian()
  (WHILE (NOT (SETQ pt0 (getpoint "\n\t确定±0.000标高点 : "))))
  )
;;;左标高
(defun @bgleft()
  (if        (= X 0)
      (command "INSERT" "$BG-L" pt1 SC SC "0" "±0.000")
      (command "INSERT" "$BG-L" pt1 SC SC "0" dy)
    )
  )
;;;右标高
(defun @bgright()
  (if        (= X 0)
      (command "INSERT" "$BG-R" pt1 SC SC "0" "±0.000")
      (command "INSERT" "$BG-R" pt1 SC SC "0" dy)
    )
  )
;;;剖面标高
(defun @sec()
  (setq H-ceng (ureal 1 "" "层高(m)" h-ceng))
  (setq n-ceng (ureal 1 "" "层数" n-ceng))
  (setvar "osmode"0)
  (command "ucs" "o" pt0)
  (setq y0 0 n 0 pt0 (list 0 0))
  (while (< n (+ 1 n-ceng))
    (setq y (* (/ y0 1000.0) (GETVAR "DIMLFAC"))
          y (rtos y 2 3)
          )
    (if        (= y0 0)
      (command "INSERT" "$BG-R" pt0 SC SC "0" "±0.000")
      (command "INSERT" "$BG-R" pt0 SC SC "0" y)
    )
    (setq n (+ 1 n))
    (setq y0 (* n 1000.0 h-ceng))
    (setq pt0 (list 0 y0))
  )
  (command "ucs" "")
  ;(exit)
)
;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
)

;;;图层输入格式化
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
)

;;;
(defun @ukword (bit kwd msg def / inp)
  (if (and def (/= def ""))
    (setq msg (strcat "\n" msg "<" def ">:")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ":"))
  )
  (initget bit kwd)
  (setq inp (getkword msg))
  (if inp
    inp
    def
  )
)
;;;数字格式化输入
(defun @ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)

;;;出图比例
(defun @setbl1 ()
  (setq bl (@ureal 1 "" "\n输入出图比例1 : " bl)        SC (/ bl 100))
  (command "modemacro" (strcat "XCAD BY XYP." " 当前出图比例 1:" (rtos bl 2 1)))
)

;;;
(DEFUN PXYP (TXT1)
  (SETQ        TXT1 (STRCAT "\n\r      程序命令: " TXT1 "      -- xyp@bsedi.com"))
  (PRINC TXT1)
  (Princ)
)

;;;
(pxyp "LPMBG      (立剖面标高)")
(princ)
;;;-------------------------------------------
;;;END
[/php]

supor

用在什么版本上面可以？

Jerry541

立剖面标高r14.rar里的两个DWG文件是2004版本的，要转换成14格式才可以用。

shuix

我怎么没数字，只有标高符号？

蓝色香格里拉

谢谢,挺好用的,如果能把那两个块不用转化就更好,生成的标高不可以修改,