[源码]动态标高

cabinsummer

1. (defun c:bg(/ ename0 InsY Y Y0 loop code ename edata snap near blkdata scl pnt height fname)
   
2.   (setvar "CMDECHO" 0)
   
3.   (defun myerr(msg)
   
4.     (command "undo" "e")
   
5.     (if ename (entdel ename))
   
6.     (setq *error* olderr)
   
7.   )
   
8.   (defun create()
   
9.     (command "insert" "KUAI" '(0.0 0.0 0.0) scl scl "0" "0.000")
   
10.     (setq ename (entlast))
    
11.     (setq edata (entget (entnext ename)))
    
12.   )
    
13.   (defun insert()
    
14.     (setvar "DIMZIN" 0)
    
15.     (setq pnt0 (getpoint "请选择插入点\n"))
    
16.     (setq height (rtos (getreal "请输入基准标高\n") 2 3))
    
17.     (setq scl (getvar "dimscale"))
    
18.     (command ".insert" fname pnt0 scl scl "0" height)
    
19.   )
    
20.   (defun do_right()
    
21.     (setq loop nil)
    
22.     (entdel ename)
    
23.   )
    
24.   (defun do_move()
    
25.     (setq snap (cadr code))
    
26.     (entdel ename)
    
27.     (setq near (osnap snap "nea"))
    
28.     (entdel ename)
    
29.     (setq Y (nth 2 (assoc 10 (entget ename))))
    
30.     (setq Y (+ (/ (- Y InsY) 1000.0) Y0))
    
31.     (if near (setq snap near))
    
32.     (entmod (subst (cons 10 snap)(assoc 10 (setq blkdata (entget ename))) blkdata))
    
33.     (setq edata (subst (cons 10 (mapcar '+ (list (* scl 2.25)(* scl 3.42) 0.0) snap))(assoc 10 edata) edata))
    
34.     (entmod edata)
    
35.     (entmod (subst (cons 1 (rtos Y 2 3))(assoc 1 edata) edata))
    
36.     (entupd ename)
    
37.     (entupd (entnext ename))
    
38.   )
    
39.   (setq olderr *error*)
    
40.   (setq *error* myerr)
    
41.   (command "undo" "be")
    
42.   (if (or (and (not (tblsearch "block" "KUAI"))(setq fname (findfile "KUAI.dwg")))(not (ssget "x" '((0 . "INSERT")(2 . "KUAI")))))(insert))
    
43.   (if (and (setq ename0 (car (entsel "请选择标高基准\n")))(= (cdr (assoc 2 (entget ename0))) "KUAI"))
    
44.     (progn
    
45.       (setq InsY (nth 2 (assoc 10 (entget ename0))))
    
46.       (setq scl (cdr (assoc 41 (entget ename0))))
    
47.       (setq Y0 (atof (cdr (assoc 1 (entget (entnext ename0))))))
    
48.       (create)
    
49.       (setq loop T)
    
50.       (while loop
    
51.         (setq code (grread T 8))
    
52.         (cond
    
53.           ((= (car code) 5)(do_move))
    
54.           ((= (car code) 3)(create))
    
55.           ((or (= (car code) 11)(= (car code) 25))(do_right))
    
56.         )
    
57.       )
    
58.     )
    
59.   )
    
60.   (command "undo" "e")
    
61.   (setq *error* olderr)
    
62.   (princ)
    
63. )

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

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

hetozju_ming

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

hetozju_ming

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

寒潮大冬瓜

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

完整武器

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

myjping

好像没反应，

cabinsummer

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

myjping

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

無恒的地盘

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

cabinsummer

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

更新，有提示了

無恒的地盘

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

fergus1987

谢谢楼主分享!

myjping

不错，楼主你可以做得更好