分享：entmake创建水平标注垂直标注

小万LISP

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")
•     )
•   )
• )
  

小万LISP

如果要想创建垂直标注，只要把
'(50 . 1.5708) ;旋转弧度，垂直=1.5708，水平时=0可删除此项
加入到
'(100 . "AcDbRotatedDimension")
前面一行，即可。

669423907

谢谢谢谢楼主分享好程序

f4800

小万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) ;还原字体系统变量
)