edata 发表于 2014-6-2 00:03 static/image/common/back.gif
当前样式不要用替代。
替代需要更改扩展数据的组码。
或者通过vla方式更改标注数据。
嗯 OK.`````````````````````````
(defun c:ts (/ p q pt en obj)
;(setvar'osmode 16384)
(setq os_bak(getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq p (getpoint "\n指定起点"))
(while p
(if p
(progn
(command "pline" "_non" p)
(while (setq q (getpoint p "下一点")
pt (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
)
(command "_non" q)
(setq en (entmakex
(list '(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10
(polar p
(+ (* 0.5 pi) (if (and (< (/ Pi 2) (angle p q))
(> (* 1.5 pi) (angle p q))
)
(angle q p)
(angle p q)
))
(* 6 (getvar "dimscale"))
)
)
'(70 . 33)
'(1 . "")
'(100 . "AcDbAlignedDimension")
(cons 13 (polar q
(+ (* 0.5 pi) (if (and (< (/ Pi 2) (angle p q))
(> (* 1.5 pi) (angle p q))
)
(angle q p)
(angle p q)
))
(* 3 (getvar "dimscale"))
))
(cons 14 (polar p
(+ (* 0.5 pi) (if (and (< (/ Pi 2) (angle p q))
(> (* 1.5 pi) (angle p q))
)
(angle q p)
(angle p q)
))
(* 3 (getvar "dimscale"))
))
)
)
obj(vlax-ename->vla-object en))
(vla-put-ScaleFactor obj (getvar "dimscale"))
(entmake (list '(0 . "TEXT")
(cons 10 pt)
(cons 40 1)
(cons 1 (rtos (distance p q) 2 2))
(cons 50
(if (and (< (/ Pi 2) (angle p q))
(> (* 1.5 pi) (angle p q))
)
(angle q p)
(angle p q)
)
)
;(cons 7 "city")
(cons 72 1)
(cons 73 1)
(cons 40 (* 2 (getvar "dimscale")))
(cons 11 pt)
)
)
(setq p q)
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(setq p (getpoint "\n指定起点"))
)
;(setvar 'osmode (- (getvar osmode) 16384))
)
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(if os_bak(setvar 'cmdecho os_bak))
(princ)
)
(defun c:tts(/ p q pt)
;(setvar'osmode 16384)
(setqp (getpoint"指定起点"))
(while p
(if p
(progn
(command "pline" p)
(while (setq q (getpoint p"下一点") pt (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q)) pt (polar pt (+ (angle p q)1.5708) (* 3 (getvar "dimscale"))))
(command q)
(entmake
(list
'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 pt)
(cons 40 (* 2 (getvar "dimscale")))
(cons 1 (rtos (distance p q) 2 2))
(cons 50 (if (and (<(/ Pi 2)(angle p q))(>(* 1.5 pi)(angle p q)))(angle q p)(angle p q)))
(cons 7 "HZTXT");改了文字样式，自己改回去。
(cons 72 1)
(cons 73 1)
;(cons 40 (* 2 (getvar "dimscale")))
(cons 11 pt)
)
)
(setq p q)
)
(command "")
(setq p(getpoint"指定起点"))
)
(setvar'osmode(-(getvar osmode)16384))
)
)
(princ)
)
不知这是不是你所想要的。
edata 发表于 2014-6-2 00:11 static/image/common/back.gif
Perfect 端午节快乐dal标注命令的第三个点命令参数哪里调的
reyun 发表于 2014-6-2 00:17 static/image/common/back.gif
(defun c:tts(/ p q pt)
;(setvar'osmode 16384)
(setqp (getpoint"指定起点"))
不错 谢谢帮忙
edata 发表于 2014-6-2 00:11 static/image/common/back.gif
我已经知道了`.`~ 谢谢帮忙
edata 发表于 2014-6-1 23:32 static/image/common/back.gif
仅供参考，
程序不错，可是标注有2个，如果只要其中一个，就是带箭头那组数据不要显示，如何修改，请您告诉我，谢谢！
香田里浪人 发表于 2014-6-2 10:44 static/image/common/back.gif
程序不错，可是标注有2个，如果只要其中一个，就是带箭头那组数据不要显示，如何修改，请您告诉我，谢谢！ ...
(defun c:`d (/ p q pt en obj)
;(setvar'osmode 16384)
;by e版主
(setq os_bak(getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq p (getpoint "\n指定起点"))
(while p
(if p
(progn
(command "pline" "_non" p)
(while (setq q (getpoint p "下一点")
pt (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
)
(command "_non" q)
(entmake (list '(0 . "TEXT")
(cons 10 pt)
(cons 40 1)
(cons 1 (rtos (distance p q) 2 2))
(cons 50
(if (and (< (/ Pi 2) (angle p q))
(> (* 1.5 pi) (angle p q))
)
(angle q p)
(angle p q)
)
)
(cons 7 "city")
(cons 72 1)
(cons 73 1)
(cons 40 (* 2 (getvar "dimscale")))
(cons 11 pt)
)
)
(setq p q)
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(setq p (getpoint "\n指定起点"))
)
;(setvar 'osmode (- (getvar osmode) 16384))
)
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(if os_bak(setvar 'cmdecho os_bak))
(princ)
)
鱼与熊掌君，谢谢你答复，
香田里浪人 发表于 2014-6-2 14:36 static/image/common/back.gif
鱼与熊掌君，谢谢你答复，
不客气`~~~~~~~~~