cabinsummer 发表于 2011-12-20 07:54:28

[源码]动态标高

本帖最后由 cabinsummer 于 2016-12-24 15:08 编辑


(defun c:bg(/ ename0 InsY Y Y0 loop code ename edata snap near blkdata scl pnt height fname)
(setvar "CMDECHO" 0)
(defun myerr(msg)
    (command "undo" "e")
    (if ename (entdel ename))
    (setq *error* olderr)
)
(defun create()
    (command "insert" "KUAI" '(0.0 0.0 0.0) scl scl "0" "0.000")
    (setq ename (entlast))
    (setq edata (entget (entnext ename)))
)
(defun insert()
    (setvar "DIMZIN" 0)
    (setq pnt0 (getpoint "请选择插入点\n"))
    (setq height (rtos (getreal "请输入基准标高\n") 2 3))
    (setq scl (getvar "dimscale"))
    (command ".insert" fname pnt0 scl scl "0" height)
)
(defun do_right()
    (setq loop nil)
    (entdel ename)
)
(defun do_move()
    (setq snap (cadr code))
    (entdel ename)
    (setq near (osnap snap "nea"))
    (entdel ename)
    (setq Y (nth 2 (assoc 10 (entget ename))))
    (setq Y (+ (/ (- Y InsY) 1000.0) Y0))
    (if near (setq snap near))
    (entmod (subst (cons 10 snap)(assoc 10 (setq blkdata (entget ename))) blkdata))
    (setq edata (subst (cons 10 (mapcar '+ (list (* scl 2.25)(* scl 3.42) 0.0) snap))(assoc 10 edata) edata))
    (entmod edata)
    (entmod (subst (cons 1 (rtos Y 2 3))(assoc 1 edata) edata))
    (entupd ename)
    (entupd (entnext ename))
)
(setq olderr *error*)
(setq *error* myerr)
(command "undo" "be")
(if (or (and (not (tblsearch "block" "KUAI"))(setq fname (findfile "KUAI.dwg")))(not (ssget "x" '((0 . "INSERT")(2 . "KUAI")))))(insert))
(if (and (setq ename0 (car (entsel "请选择标高基准\n")))(= (cdr (assoc 2 (entget ename0))) "KUAI"))
    (progn
      (setq InsY (nth 2 (assoc 10 (entget ename0))))
      (setq scl (cdr (assoc 41 (entget ename0))))
      (setq Y0 (atof (cdr (assoc 1 (entget (entnext ename0))))))
      (create)
      (setq loop T)
      (while loop
      (setq code (grread T 8))
      (cond
          ((= (car code) 5)(do_move))
          ((= (car code) 3)(create))
          ((or (= (car code) 11)(= (car code) 25))(do_right))
      )
      )
    )
)
(command "undo" "e")
(setq *error* olderr)
(princ)
)

将KUAI.dwg放到支持目录里，加载bg.lsp
命令：BG
根据命令行提示操作，先选择基准标高。
左键选择，右键退出

hetozju_ming 发表于 2023-1-13 15:48:55

在楼主的基础之上我改写了动态标高的部分内容，可以捕捉点了，标高块会自动生成。

hetozju_ming 发表于 2022-4-14 11:54:58

如果把基准标高镜像后再使用，因为块参照X比例是负数，所以文字和标高是反的。我把源码里的插入的Y方向比例值改为绝对值后，标高符号位置正确了，但是文字显示是反的。查询了属性文字的插入点也已经更新了，不知道这是什么原因。

寒潮大冬瓜 发表于 2024-11-13 09:00:36

看看我这个是否符合版主的思路？cass通用升级版CGC圆圈高程(标高Gu_xl)点CFC三角形高程(标高77077)点创建http://bbs.mjtd.com/forum.php?mod=viewthread&tid=191534&fromuid=418631

完整武器 发表于 2011-12-20 08:47:58

这个要顶哦 谢谢共享源码！

myjping 发表于 2011-12-20 10:15:09

好像没反应，

cabinsummer 发表于 2011-12-20 10:52:24

本帖最后由 cabinsummer 于 2011-12-20 23:03 编辑

键入BG命令后，要先选择原始标高的块。如果不选或选错，程序退出。

myjping 发表于 2011-12-20 11:21:30

觉得楼主再改一下会更好，最好是把块加在程序里，同时加上各种提示; 现在论坛上很多东东都非常不错，只是操作性比较差

無恒的地盘 发表于 2011-12-20 15:45:17

我觉得海龙工具箱里面的自动标高程序功能很好用
楼主这个加载了没反应

cabinsummer 发表于 2011-12-20 23:02:44

無恒的地盘 发表于 2011-12-20 15:45 static/image/common/back.gif
我觉得海龙工具箱里面的自动标高程序功能很好用
楼主这个加载了没反应

更新，有提示了

無恒的地盘 发表于 2011-12-22 08:47:42

用起来好像不是很方便
这里有以前张越写的一个标高程序 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=3960

fergus1987 发表于 2011-12-22 08:56:17

谢谢楼主分享!

myjping 发表于 2011-12-22 10:22:04

不错，楼主你可以做得更好
页: [1] 2 3 4 5
查看完整版本: [源码]动态标高