找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 5332|回复: 77

[分享]:立剖面标高程序(免币)

[复制链接]
发表于 2004-11-14 14:26:30 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
[php]
立剖面标高程序。
将压缩文件下载解压后,放到Acad搜索路径下,加载dtbg(动态标高).fas,运行dtbg。
功能:
1. 立面图、剖面图中先确定±0.000基点,然后点取要标注标高的点,自动生成标高,左右方向标高均可。
2. 剖面图楼层标高标注:先确定±0.000基点,然后输入层高、层数,自动在各楼层生成标高。
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2004-11-14 20:25:41 | 显示全部楼层
程序示意:
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-15 08:40:58 | 显示全部楼层
说说有什么功能?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-11-15 11:49:51 | 显示全部楼层
功能介绍在一楼!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-16 01:44:43 | 显示全部楼层
呵呵。这样方便多了
谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-16 06:51:35 | 显示全部楼层
其中的.FAS文件是否也要放到ACAD的搜索路径中?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-11-16 12:36:06 | 显示全部楼层
.FAS是程序文件,呵呵……
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-28 19:24:13 | 显示全部楼层
r14下好像不能用,出现Command: lpmbg

错误: null function
nil*Cancel*
的文字.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-28 20:14:11 | 显示全部楼层
Good !
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-28 21:45:23 | 显示全部楼层
14中用不了呀,真是可惜.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-11-28 22:18:33 | 显示全部楼层
提供源文件,供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]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-29 08:33:38 | 显示全部楼层
用在什么版本上面可以?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-29 09:23:47 | 显示全部楼层
立剖面标高r14.rar里的两个DWG文件是2004版本的,要转换成14格式才可以用。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-29 21:40:44 | 显示全部楼层
我怎么没数字,只有标高符号?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-11-30 18:08:04 | 显示全部楼层
谢谢,挺好用的,如果能把那两个块不用转化就更好,生成的标高不可以修改,
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-25 00:01 , Processed in 0.344521 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表