欢迎来拍砖
说明：由于本人经常要用标高做一些计算(尤其是总图)，所以个人认为做成属性标高有利于其他程序直接调用数据(比如说计算总图排水坡度坡向等)，所以用标高块的形式做标高，喜欢的可以拿去用用。。。。[code="lisp]
;创建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)
)[/code]
lisp写标高线_属性块形式的标高标注程序！ - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
