分享：entmake创建水平标注垂直标注
本帖最后由 小万LISP 于 2019-9-30 08:38 编辑entmake创建标注的时候，似乎某些列表的顺序不能乱，否则出错。看我的搞法：
[*];水平标注测试
[*](defun c:tt(/ a b )
[*](setq
[*] a(getpoint "\n 指定起点:")
[*] b(getpoint "\n 指定终点:")
[*])
[*](DimX a b 1)
[*](DimX a b 2)
[*](DimX a b 3)
[*](DimX a b 4)
[*](DimX a b 1000);需要多高写多高
[*](DimX a b -1500);需要多高写多高
[*](princ)
[*])
[*];自定义函数-水平标注，起点、终点、高度编号(上1、2，下3、4)，图层=3制图_标注
[*](defun DimX(a b h)
[*](setq h
[*] (cond
[*] ((= h 1)250);图形上方第1层标注高度
[*] ((= h 2)550);图形上方第2层标注高度
[*] ((= h 3)-370);图形下方第1层标注高度
[*] ((= h 4)-740);图形下方第2层标注高度
[*] (t h)
[*] )
[*])
[*](setq a (trans a 1 0) b (trans b 1 0) ) ;把点坐标从当前坐标系转换为世界坐标系
[*](entmake
[*] (list
[*] '(0 . "DIMENSION")
[*] '(100 . "AcDbEntity")
[*] '(8 . "3制图_标注");图层
[*] '(100 . "AcDbDimension")
[*] (cons 10 (list(car a)(+(cadr a)h)));标注线高度定义点坐标
[*] '(70 . 32);垂直/水平标注为32，倾斜标注为33
[*] '(1 . "");文字替代内容，默认为空
[*] '(3 . "DIM_200");标注样式
[*] '(100 . "AcDbAlignedDimension")
[*] (cons 13 a);标注起点坐标
[*] (cons 14 b) ;标注终点坐标
[*] ;'(50 . 1.5708) ;旋转弧度，垂直=1.5708，水平时=0可删除此项
[*] '(100 . "AcDbRotatedDimension")
[*] )
[*])
[*])
如果要想创建垂直标注，只要把
'(50 . 1.5708) ;旋转弧度，垂直=1.5708，水平时=0可删除此项
加入到
'(100 . "AcDbRotatedDimension")
前面一行，即可。 谢谢谢谢楼主分享好程序 小万LISP 发表于 2019-9-30 08:27
如果要想创建垂直标注，只要把
'(50 . 1.5708) ;旋转弧度，垂直=1.5708，水平时=0可删除此项
加入到
大佬们这段源码标注的文字是水平的怎么修改为增加可选项 ，有水平或垂直标注的选择？多谢了
(defun c:zbbz (/ LC:TEXTLENGTH TEXTSTYLE-BAK TEXTSIZE-BAK TEXTHIGH XSWS PT1 PT2 STRLST TEXTLENGTH PT3 LST)
(defun LC:TextLength (String / Tbox)
(setq Tbox (textbox (list (cons 1 String))))
(distance (car Tbox) (cadr Tbox))
)
(setq TEXTSTYLE-bak(getvar "TEXTSTYLE"))
(setvar "TEXTSTYLE" "Standard")
(setq textsize-bak (Getvar "textsize")) ;字高系统变量
(setq texthigh (getreal "\n请输入文字高度<1.5>: "))
(if (null texthigh) (setq texthigh 1.5))
(Setvar "textsize" texthigh)
(setq xsws (getint "\n 请输入小数位数<3>: "))
(if (null xsws) (setq xsws 3))
(while (setq pt1 (getpoint "\n 指定注记点: "))
(setq pt2 (getpoint "注记位置: "))
(setq strlst (mapcar'strcat'("Y= " "X= " "H= ")(mapcar '(lambda (x) (rtos x 2 xsws)) pt1)))
(setq textlength (apply 'MAX (mapcar '(lambda (x) (LC:TextLength x)) strlst)));文字最大长度
(setq pt3 (if (> (car pt2) (car pt1))
(polar pt2 0 (+ textlength 1))
(polar pt2 pi (+ textlength 1))
)
)
(setq lst (list pt1 pt2 pt3))
(entmake (list '(0 . "TEXT")'(41 . 1.0)(cons 1 (cadr strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 0.5 pi) (* texthigh 0.2))) (cons 40 texthigh)))
(entmake (list '(0 . "TEXT")'(41 . 1.0) (cons 1 (car strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.2) texthigh))) (cons 40 texthigh)))
(entmake (list '(0 . "TEXT") '(41 . 1.0)(cons 1 (last strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.4) (* texthigh 2.0)))) (cons 40 texthigh)))
(entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst)))(mapcar '(lambda (pt) (cons 10 pt)) lst)))
)
(Setvar "textsize" textsize-bak) ;还原字高系统变量
(setvar "TEXTSTYLE" TEXTSTYLE-bak) ;还原字体系统变量
)
页:
[1]