属性块形式的标高标注程序！

77077

欢迎来拍砖
说明：由于本人经常要用标高做一些计算（尤其是总图），所以个人认为做成属性标高有利于其他程序直接调用数据（比如说计算总图排水坡度坡向等），所以用标高块的形式做标高，喜欢的可以拿去用用。。。。

2. ;创建4种标高形式的属性块（实心）
   
3. (defun Make-Block-4BGS( / mkblock-bg lst n)
   
4.   (defun mkblock-bg (blkname 4pt p)
   
5.     (entmake (list  (cons 0 "BLOCK") (cons 2 blkname) '(70 . 2) '(10 0 0)))
   
6.     (entmake (append (list '(0 . "LWPOLYLINE") '(8 . "0") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length 4pt)))
   
7.                      (mapcar '(lambda (pt)(cons 10 pt)) 4pt)
   
8.                      )
   
9.              )
   
10.           (entmake (list '(0 . "LINE") '(8 . "0") '(10 -3 0) '(11 3 0)));是否要小短线，不要则删除此行
    
11.           (entmake (list '(0 . "SOLID") '(8 . "0") (cons 10 (car 4pt)) (cons 11 (car 4pt)) (cons 12 (cadr 4pt)) (cons 13 (caddr 4pt))));是否实心，不要实心则删除此行
    
12.     (entmake (list '(0 . "ATTDEF") '(1 . "0.000") '(2 . "H") '(3 . "H") '(70 . 0) '(7 . "Standard") '(8 . "0")
    
13.                             (cons 10 P) (cons 11 P) '(40 . 3.5) '(41 . 0.7)  '(50 . 0.0) '(51 . 0.0)  '(71 . 0) '(72 . 0)   '(73 . 0)
    
14.                          )
    
15.              )
    
16.     (entmake '((0 . "endblk")))
    
17.     )
    
18.   (setq lst '(
    
19.               ("1001-标高S" ((3 3)(0 0)(-3 3)(12 3)) (3 3.5));标高块名称 点表 文字位置
    
20.               ("1002-标高S" ((-3 3)(0 0)(3 3)(-12 3)) (-12 3.5))
    
21.               ("1003-标高S" ((-3 -3)(0 0)(3 -3)(-12 -3)) (-12 -7.0))
    
22.               ("1004-标高S" ((3 -3)(0 0)(-3 -3)(12 -3)) (3 -7.0))
    
23.               )
    
24.         )
    
25.   (foreach n lst
    
26.     (if (not (tblsearch "block" (car n)))
    
27.       (mkblock-bg (car n) (cadr n) (caddr n))
    
28.       )
    
29.     )
    
30.   )
    
31. ;主程序1，手动输入标高,适用于总图部分标注各点标高
    
32. (defun c:sdbg( / p1 ang bg)
    
33.   (princ "\n 手动输入标高,适用于总图部分标注各点标高!")
    
34.   (Make-Block-4BGK)
    
35.   (while (setq p1 (getpoint"\n基点位置:"))
    
36.     (setq ang (getangle p1 "方向: ")
    
37.           bg (rtos (getreal "输入标高:") 2 3)
    
38.           )
    
39.     (cond
    
40.       ((< ang (* 0.5 pi))(setq blkname "1001-标高S"))
    
41.       ((< ang pi)    (setq blkname "1002-标高"))
    
42.       ((< ang (* 1.5 pi))(setq blkname "1003-标高S"))
    
43.       ((< ang (* 2 pi)) (setq blkname "1004-标高S"))
    
44.     )
    
45.     (command "_insert" blkname p1 1 1 0 bg)
    
46.   )
    
47.   (princ "谢谢使用！")
    
48.   (princ)
    
49. )
    
50. 
    
51. ;主程序2，连续标高标注，适用于建筑立面连续标注标高
    
52. (defun c:lxbg( / bl p1 ang y1 bg1 bg2 blkname)
    
53.   (princ "\n 连续标高标注，适用于建筑立面连续标注标高!")
    
54.   (setq BL (getreal"\设置比例<1:1000>:"))
    
55.   (if (null bl) (setq bl 1000))
    
56.   (Make-Block-4BGS)
    
57.   (setq p1 (getpoint"\起点位置:")
    
58.         ang (getangle p1 "方向: ")
    
59.         bg1 (getreal "起点标高:")
    
60.         y1 (- (cadr p1) (* bg1 BL))
    
61.         bg1 (rtos bg1 2 3)        
    
62.        )
    
63.     (cond
    
64.       ((< ang (* 0.5 pi))(setq blkname "1001-标高S"))
    
65.       ((< ang pi)    (setq blkname "1002-标高"))
    
66.       ((< ang (* 1.5 pi))(setq blkname "1003-标高S"))
    
67.       ((< ang (* 2 pi)) (setq blkname "1004-标高S"))
    
68.     )
    
69.   (command "_insert" blkname p1 BL BL 0 bg1)
    
70.   (while (setq p2 (getpoint"\n下一点:"))
    
71.     (setq bg2 (rtos(/ (- (cadr p2) y1) BL)2 3))
    
72.     (command "_insert" blkname p2 BL BL 0 bg2)
    
73.   )
    
74.   (princ "谢谢使用！")
    
75.   (princ)
    
76. )

;创建4种标高形式的属性块（实心）<br /> (defun Make-Block-4BGS( / mkblock-bg lst n)<br />   (defun mkblock-bg (blkname 4pt p)<br />     (entmake (list  (cons 0 "BLOCK") (cons 2 blkname) '(70 . 2) '(10 0 0)))<br />     (entmake (append (list '(0 . "LWPOLYLINE") '(8 . "0") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length 4pt)))<br />                      (mapcar '(lambda (pt)(cons 10 pt)) 4pt)<br />                      )<br />              )<br />           (entmake (list '(0 . "LINE") '(8 . "0") '(10 -3 0) '(11 3 0)));是否要小短线，不要则删除此行<br />           (entmake (list '(0 . "SOLID") '(8 . "0") (cons 10 (car 4pt)) (cons 11 (car 4pt)) (cons 12 (cadr 4pt)) (cons 13 (caddr 4pt))));是否实心，不要实心则删除此行<br />     (entmake (list '(0 . "ATTDEF") '(1 . "0.000") '(2 . "H") '(3 . "H") '(70 . 0) '(7 . "Standard") '(8 . "0")<br />                             (cons 10 P) (cons 11 P) '(40 . 3.5) '(41 . 0.7)  '(50 . 0.0) '(51 . 0.0)  '(71 . 0) '(72 . 0)   '(73 . 0)<br />                          )<br />              )<br />     (entmake '((0 . "endblk")))<br />     )<br />   (setq lst '(<br />               ("1001-标高S" ((3 3)(0 0)(-3 3)(12 3)) (3 3.5));标高块名称 点表 文字位置<br />               ("1002-标高S" ((-3 3)(0 0)(3 3)(-12 3)) (-12 3.5))<br />               ("1003-标高S" ((-3 -3)(0 0)(3 -3)(-12 -3)) (-12 -7.0))<br />               ("1004-标高S" ((3 -3)(0 0)(-3 -3)(12 -3)) (3 -7.0))<br />               )<br />         )<br />   (foreach n lst<br />     (if (not (tblsearch "block" (car n)))<br />       (mkblock-bg (car n) (cadr n) (caddr n))<br />       )<br />     )<br />   )<br /> ;主程序1，手动输入标高,适用于总图部分标注各点标高<br /> (defun c:sdbg( / p1 ang bg)<br />   (princ "\n 手动输入标高,适用于总图部分标注各点标高!")<br />   (Make-Block-4BGK)<br />   (while (setq p1 (getpoint"\n基点位置:"))<br />     (setq ang (getangle p1 "方向: ")<br />           bg (rtos (getreal "输入标高:") 2 3)<br />           )<br />     (cond<br />       ((< ang (* 0.5 pi))(setq blkname "1001-标高S"))<br />       ((< ang pi)    (setq blkname "1002-标高"))<br />       ((< ang (* 1.5 pi))(setq blkname "1003-标高S"))<br />       ((< ang (* 2 pi)) (setq blkname "1004-标高S"))<br />     )<br />     (command "_insert" blkname p1 1 1 0 bg)<br />   )<br />   (princ "谢谢使用！")<br />   (princ) <br /> )<br /> <br /> ;主程序2，连续标高标注，适用于建筑立面连续标注标高<br /> (defun c:lxbg( / bl p1 ang y1 bg1 bg2 blkname)<br />   (princ "\n 连续标高标注，适用于建筑立面连续标注标高!")<br />   (setq BL (getreal"\设置比例<1:1000>:"))<br />   (if (null bl) (setq bl 1000))<br />   (Make-Block-4BGS)<br />   (setq p1 (getpoint"\起点位置:")<br />         ang (getangle p1 "方向: ")<br />         bg1 (getreal "起点标高:")<br />         y1 (- (cadr p1) (* bg1 BL))<br />         bg1 (rtos bg1 2 3)        <br />        )<br />     (cond<br />       ((< ang (* 0.5 pi))(setq blkname "1001-标高S"))<br />       ((< ang pi)    (setq blkname "1002-标高"))<br />       ((< ang (* 1.5 pi))(setq blkname "1003-标高S"))<br />       ((< ang (* 2 pi)) (setq blkname "1004-标高S"))<br />     )<br />   (command "_insert" blkname p1 BL BL 0 bg1)<br />   (while (setq p2 (getpoint"\n下一点:"))<br />     (setq bg2 (rtos(/ (- (cadr p2) y1) BL)2 3))<br />     (command "_insert" blkname p2 BL BL 0 bg2)<br />   )<br />   (princ "谢谢使用！")<br />   (princ) <br /> )

寒潮大冬瓜

yangchao2005090 发表于 2019-5-18 22:23
请问属性块如何设置成三角新呀

;(entmake (list '(0 . "LINE") '(8 . "0") '(10 -3 0) '(11 3 0)));是否要小短线，不要则删除此行
          ;(entmake (list '(0 . "SOLID") '(8 . "0") (cons 10 (car 4pt)) (cons 11 (car 4pt)) (cons 12 (cadr 4pt)) (cons 13 (caddr 4pt))));是否实心，不要实心则删除此行
代码里有提示！
楼主辛苦了！四个象限分别设置四个块来创建

寒潮大冬瓜

期待大侠在代码里实现“中望CAD建筑版”标高功能
利用CAD字段制作动态变化的标高图块  http://www.360doc.com/content/18/0328/21/9816594_741092421.shtml

yangchao2005090

请问属性块如何设置成三角新呀

77077

大意了一点(Make-Block-4BGK)应该为(Make-Block-4BGS),这里调用的是做4个实心标高块~~~~~

yoyoho

感谢 77077 分享程序,谢谢!

fl202

最好有个演示，一目了然。

gaics

有两个问题：
1.第40行“1002-标高”少个S。
2.需要修改两个系统变量才能正常运行：ATTDIA=0，ATTREQ=1。

夺天工

gaics 发表于 2015-4-29 10:55
有两个问题：
1.第40行“1002-标高”少个S。
2.需要修改两个系统变量才能正常运行：ATTDIA=0，ATTREQ=1。

在哪修改系统变量

夺天工

修改了，加载后sdbg和lxbg提示是无效命令

Biu丸子

有错误啊 哦呃

szx025

程序有点小问题，在新建的dwg文件中可以运行，但在打开已有的图后，运行程序出错

tumu2008323

修改了可以使用，手动标高也添加输入比例，感谢原作者，很好用