[LISP程序]：一个立面图标高的程序

long78

下载下来试用感觉还不错。

fallenleaf

这么多好东西，可是不让我下载

zh_6531394

太小,修改不方便

hop_wh

我新来,想下来试试,很不错的功能

yjtdkj

最初由 xyzjint_cn 发布
[B]以后补上，其实也很简单，只要将各个点的坐标重新设置一下就行了，如有谁改了，请上传供大家下载

大家好：
刚改了这个程序，使其可左右标注，用法还同以前一样，只是在点基准点之后提示是标左面还是右面，直接?.. [/B]

晓东网站的附件现在不能下了，能不能把程序贴出来或电邮给我：yjtdkj8156262@163.com

oklaishu

我的下了还好的哦

xyp1964

标高还是以“图块”的方式较好，编辑（修改、移动、复制、删除等）较方便！
提供个立剖面标高的原程序供测试：
[php]
;|
LPMBG.lsp 立剖面标高
* C:LPMBG
-- XYP@bsedi.com
2004.11.14
|;
(prompt "\n\r      加载立剖面标高程序。")
;;;-------------------------------------------
;;;主程序
(DEFUN C:LPMBG (/ pt1 x x1 dy)
  (CMDLA0)
  (vl-cmdf ".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))
    )))
  (vl-cmdf ".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]
将压缩文件下载解压后，放到Acad搜索路径下，加载lpmbg.lsp程序，运行lpmbg。
程序下载：
http://www.xdcad.net/forum/showt ... 1461203#post1461203

jeepsheep

我下了,挺不错的,就是画出来的标高不是一个整体,而且改不了比例!
希望有高手帮忙改改!
22楼主提供的要给币下载他的附件才能使用,感觉一般!

ruan_gdqf

如果能象天正6.0里面的标高标注那么智能的话就再好不过了.
楼主考虑过这样作了吗?

makemyday123

真是好东西啊

dydlyz

很好用呀,太喜欢了

shuaier

好东西，我下载了。

HONG2112

很好用，不错

lony1019

如果可以改变子高就好了！谢谢

jintly

标出来的文字是block吗？以后修改怎么办？