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

77077 发表于 2015-4-20 16:01:50

欢迎来拍砖
说明：由于本人经常要用标高做一些计算（尤其是总图），所以个人认为做成属性标高有利于其他程序直接调用数据（比如说计算总图排水坡度坡向等），所以用标高块的形式做标高，喜欢的可以拿去用用。。。。;创建4种标高形式的属性块（实心）
(defun Make-Block-4BGS( / mkblock-bg lst n)
(defun mkblock-bg (blkname 4pt p)
(entmake (list(cons 0 "BLOCK") (cons 2 blkname) '(70 . 2) '(10 0 0)))
(entmake (append (list '(0 . "LWPOLYLINE") '(8 . "0") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length 4pt)))
      (mapcar '(lambda (pt)(cons 10 pt)) 4pt)
      )
      )
   (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))));是否实心，不要实心则删除此行
(entmake (list '(0 . "ATTDEF") '(1 . "0.000") '(2 . "H") '(3 . "H") '(70 . 0) '(7 . "Standard") '(8 . "0")
            (cons 10 P) (cons 11 P) '(40 . 3.5) '(41 . 0.7)'(50 . 0.0) '(51 . 0.0)'(71 . 0) '(72 . 0) '(73 . 0)
         )
      )
(entmake '((0 . "endblk")))
)
(setq lst '(
      ("1001-标高S" ((3 3)(0 0)(-3 3)(12 3)) (3 3.5));标高块名称点表文字位置
      ("1002-标高S" ((-3 3)(0 0)(3 3)(-12 3)) (-12 3.5))
      ("1003-标高S" ((-3 -3)(0 0)(3 -3)(-12 -3)) (-12 -7.0))
      ("1004-标高S" ((3 -3)(0 0)(-3 -3)(12 -3)) (3 -7.0))
      )
)
(foreach n lst
(if (not (tblsearch "block" (car n)))
   (mkblock-bg (car n) (cadr n) (caddr n))
   )
)
)
;主程序1，手动输入标高,适用于总图部分标注各点标高
(defun c:sdbg( / p1 ang bg)
(princ "\n 手动输入标高,适用于总图部分标注各点标高!")
(Make-Block-4BGK)
(while (setq p1 (getpoint"\n基点位置:"))
(setq ang (getangle p1 "方向: ")
      bg (rtos (getreal "输入标高:") 2 3)
      )
(cond
   ((< ang (* 0.5 pi))(setq blkname "1001-标高S"))
   ((< ang pi) (setq blkname "1002-标高"))
   ((< ang (* 1.5 pi))(setq blkname "1003-标高S"))
   ((< ang (* 2 pi)) (setq blkname "1004-标高S"))
)
(command "_insert" blkname p1 1 1 0 bg)
)
(princ "谢谢使用！")
(princ)
)

;主程序2，连续标高标注，适用于建筑立面连续标注标高
(defun c:lxbg( / bl p1 ang y1 bg1 bg2 blkname)
(princ "\n 连续标高标注，适用于建筑立面连续标注标高!")
(setq BL (getreal"\设置比例<1:1000>:"))
(if (null bl) (setq bl 1000))
(Make-Block-4BGS)
(setq p1 (getpoint"\起点位置:")
   ang (getangle p1 "方向: ")
   bg1 (getreal "起点标高:")
   y1 (- (cadr p1) (* bg1 BL))
   bg1 (rtos bg1 2 3)
   )
(cond
   ((< ang (* 0.5 pi))(setq blkname "1001-标高S"))
   ((< ang pi) (setq blkname "1002-标高"))
   ((< ang (* 1.5 pi))(setq blkname "1003-标高S"))
   ((< ang (* 2 pi)) (setq blkname "1004-标高S"))
)
(command "_insert" blkname p1 BL BL 0 bg1)
(while (setq p2 (getpoint"\n下一点:"))
(setq bg2 (rtos(/ (- (cadr p2) y1) BL)2 3))
(command "_insert" blkname p2 BL BL 0 bg2)
)
(princ "谢谢使用！")
(princ)
)

寒潮大冬瓜 发表于 2024-8-25 17:55:52

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))));是否实心，不要实心则删除此行
代码里有提示！
楼主辛苦了！四个象限分别设置四个块来创建

寒潮大冬瓜 发表于 2024-8-25 21:29:09

本帖最后由寒潮大冬瓜于 2024-8-25 21:33 编辑

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

yangchao2005090 发表于 2019-5-18 22:23:01

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

77077 发表于 2015-4-20 16:05:27

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

yoyoho 发表于 2015-4-20 22:34:47

感谢 77077 分享程序,谢谢!

fl202 发表于 2015-4-21 08:56:56

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

gaics 发表于 2015-4-29 10:55:22

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

夺天工 发表于 2015-5-1 22:40:11

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

在哪修改系统变量

夺天工 发表于 2015-5-1 22:48:40

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

Biu丸子 发表于 2015-5-28 22:39:56

有错误啊哦呃

szx025 发表于 2015-5-29 09:26:31

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

tumu2008323 发表于 2015-5-29 12:27:21

本帖最后由 tumu2008323 于 2015-5-29 22:06 编辑

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

页: [1] 2

明经CAD社区's Archiver

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