如何让当前视口中心和四个角点显示特定字符（高飞鸟版主能有空指导更好）
本帖最后由 夏生生 于 2021-12-17 09:35 编辑这是一个坐标变换的问题，为了方便表述，我用了“如何让当前视口中心和四个角点显示特定字符”为标题。如下图效果：
当grread函数工作时，无论在何等UCS（包括xy顺时针旋转）、plan与UCS配合、视图（3DORBIT）的情况下，在当前视口中心和四个角点显示固定像素大小的特定字符。效果与DCL相似，DCL无论你的坐标系统是什么样的，它始终在屏幕上以固定的大小、固定的位置显示。这里就涉及到坐标变换的问题，我仔细研究了高飞鸟版主的帖子，对于点、线的UCS、WCS、DCS转换，相对还是比较好处理，直接换算点，然后赋值即可。但是涉及到文字、块等有ECS概念的图元的时候我就不会了。恳请各位不吝赐教，谢谢。
下述代码无法处理3DORBIT的情况
(defun c:temp (/ CEN D2W GR1 GR2
H LOOP OBJL PT SC
SCR STR WB WH xty-make-text@w
xty-put-dxf xty-put-dxfl
)
(setqloop t
pt '(0 0 0)
str"特定字符"
objl (list (xty-make-text@w str 0 0 pt pt 1 1 0 "standard")
(xty-make-text@w str 0 0 pt pt 1 1 0 "standard")
(xty-make-text@w str 0 0 pt pt 1 1 0 "standard")
(xty-make-text@w str 0 0 pt pt 1 1 0 "standard")
(xty-make-text@w str 0 0 pt pt 1 1 0 "standard")
) ;_画五个临时文字
objl (mapcar 'vlax-ename->vla-object objl)
)
(while loop
(setq gr1 (grread t 15 1)
gr2 (cadr gr1)
gr1 (car gr1)
cen (trans (getvar "VIEWCTR") 1 2)
wh(getvar "VIEWSIZE")
scr (getvar "SCREENSIZE")
sc(/ wh (cadr scr))
wb(* 0.5 (* sc (car scr)))
wh(* 0.5 wh)
h (* 30 sc)
d2w (append
(mapcar'append
(mapcar
(function (lambda (v) (trans v 0 2 t)))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
(mapcar 'list (trans '(0 0 0) 2 0))
)
'((0. 0. 0. 1.))
) ;_DCS->wcs转换矩阵
)
(xty-put-dxfl
(vlax-vla-object->ename (car objl))
'(40 72 73 10 11)
(list h
0
0
(mapcar '- cen (list wb wh))
(mapcar '- cen (list wb wh))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (cadr objl))
'(40 72 73 10 11)
(list h
2
0
(mapcar '+ cen (list wb (- wh)))
(mapcar '+ cen (list wb (- wh)))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (caddr objl))
'(40 72 73 10 11)
(list h
2
3
(mapcar '+ cen (list wb wh))
(mapcar '+ cen (list wb wh))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (cadddr objl))
'(40 72 73 10 11)
(list h
0
3
(mapcar '+ cen (list (- wb) wh))
(mapcar '+ cen (list (- wb) wh))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (last objl))
'(40 72 73 10 11)
(list h 1 2 cen cen)
)
(foreach n objl (vla-TransformBy n (vlax-tMatrix d2w)))
(cond ((= 3 gr1)
(setq loop nil)
(foreach n objl (vla-delete n))
)
)
)
(defun xty-make-text@w (tt t72 t73 t10 t11 th tw t50 tst /)
(entmakex (list '(0 . "text")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 t10)
(cons 1 tt)
(cons 40 th)
(cons 41 tw)
(cons 7 tst)
(cons 72 t72)
(cons 11 t11)
(cons 50 t50)
(cons 73 t73)
)
)
)
(defun xty-put-dxf (en code ch / ent)
(setq ent (entget en))
(if(xty-get-dxf code en)
(entmod (subst (cons code ch) (assoc code ent) ent))
(entmod (append ent (list (cons code ch))))
)
(entupd en)
)
(defun xty-put-dxfl (en code-l ch-l / ent)
(setq ent (entget en))
(foreach n
code-l
(if (xty-get-dxf n en)
(setq ent (subst (cons n (car ch-l)) (assoc n ent) ent))
(setq ent (append ent (list (cons n (car ch-l)))))
)
(setq ch-l (cdr ch-l))
)
(entmod ent)
(entupd en)
)
)
本帖最后由 x_s_s_1 于 2021-12-17 10:03 编辑
自己暂时解决，通过文字的ecs，可能是计算精度的问题，坐标值过小或过大会出现意想不到的情况
悬赏再放段时间吧，看哪位大佬能给与指导，谢谢。
(defun c:temp (/ CEN D2W GR1 GR2
H LOOP OBJL PT SC
SCR STR WB WH temp
)
(setqloop t
pt '(0 0 0)
str"特定字符"
objl (list (xty-make-textw str 0 0 pt pt 1 1 0 "standard")
(xty-make-textw str 0 0 pt pt 1 1 0 "standard")
(xty-make-textw str 0 0 pt pt 1 1 0 "standard")
(xty-make-textw str 0 0 pt pt 1 1 0 "standard")
(xty-make-textw str 0 0 pt pt 1 1 0 "standard")
) ;_画五个临时文字
temp (car objl)
objl (mapcar 'vlax-ename->vla-object objl)
)
(while loop
(setq gr1 (grread t 15 1)
gr2 (cadr gr1)
gr1 (car gr1)
cen (trans (getvar "VIEWCTR") 1 2)
wh(getvar "VIEWSIZE")
scr (getvar "SCREENSIZE")
sc(/ wh (cadr scr))
wb(* 0.5 (* sc (car scr)))
wh(* 0.5 wh)
h (* 30 sc)
d2w (append
(mapcar'append
(mapcar
(function (lambda (v) (trans v temp 2 t)))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
(mapcar 'list (trans '(0 0 0) 2 temp))
)
'((0. 0. 0. 1.))
) ;_DCS->wcs转换矩阵
)
(xty-put-dxfl
(vlax-vla-object->ename (car objl))
'(40 72 73 10 11)
(list h
0
0
(mapcar '- cen (list wb wh))
(mapcar '- cen (list wb wh))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (cadr objl))
'(40 72 73 10 11)
(list h
2
0
(mapcar '+ cen (list wb (- wh)))
(mapcar '+ cen (list wb (- wh)))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (caddr objl))
'(40 72 73 10 11)
(list h
2
3
(mapcar '+ cen (list wb wh))
(mapcar '+ cen (list wb wh))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (cadddr objl))
'(40 72 73 10 11)
(list h
0
3
(mapcar '+ cen (list (- wb) wh))
(mapcar '+ cen (list (- wb) wh))
)
)
(xty-put-dxfl
(vlax-vla-object->ename (last objl))
'(40 72 73 10 11)
(list h 1 2 cen cen)
)
(foreach n objl (vla-TransformBy n (vlax-tMatrix d2w)))
(cond ((= 3 gr1)
(setq loop nil)
(foreach n objl (vla-delete n))
)
)
)
(defun xty-make-textw (tt t72 t73 t10 t11 th tw t50 tst /)
(entmakex (list '(0 . "text")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 t10)
(cons 1 tt)
(cons 40 th)
(cons 41 tw)
(cons 7 tst)
(cons 72 t72)
(cons 11 t11)
(cons 50 t50)
(cons 73 t73)
)
)
)
(defun xty-put-dxf (en code ch / ent)
(setq ent (entget en))
(if(xty-get-dxf code en)
(entmod (subst (cons code ch) (assoc code ent) ent))
(entmod (append ent (list (cons code ch))))
)
(entupd en)
)
(defun xty-put-dxfl (en code-l ch-l / ent)
(setq ent (entget en))
(foreach n
code-l
(if (xty-get-dxf n en)
(setq ent (subst (cons n (car ch-l)) (assoc n ent) ent))
(setq ent (append ent (list (cons n (car ch-l)))))
)
(setq ch-l (cdr ch-l))
)
(entmod ent)
(entupd en)
)
)
grread函数下不是很懂 但是在任意视图 包括旋转后的三维视图状态 下只要改为视图ucs 在屏幕四角和中心显示固定大小的文字应该是可以实现的 本帖最后由 夏生生 于 2021-12-13 11:39 编辑
guosheyang 发表于 2021-12-13 11:27
grread函数下不是很懂 但是在任意视图 包括旋转后的三维视图状态 下只要改为视图ucs 在屏幕四角和中 ...
这个还是比较简单，不过经您提醒，我的思路好像还是进入了误区，我再捋捋思路，谢谢
;;;=============================================
;;; 通用函数获取当前视口中视图的外包框
;;;参数： mode-------输出方式
;;;返回值：UCS下
;;;mode=0(屏幕中心DCS 每像素图形高(UCS左下 UCS右上))
;;;mode=1(屏幕中心DCS 每像素图形高 UCS左下开始逆时针点表)
(defun xty-get-vbox (mode / cen h screen b lst)
(setq cen (getvar "VIEWCTR");_当前视口中视图的中心(UCS)
h (getvar "VIEWSIZE") ;_当前视口中显示的视图的高度
screen (getvar "SCREENSIZE") ;_当前视口大小(以像素为单位)
b (/ (* h (car screen)) (cadr screen));_当前视口中显示的视图的宽度
lst (xty-G-pt->4pt (trans cen 1 2) b h 0);_当前视口中显示的视图的dcs坐标
)
(if (= 0 mode)
(setq lst (list (car lst) (caddr lst)))
lst
)
(list cen
(/ h (cadr screen))
(mapcar (function (lambda (x) (trans x 2 1))) lst)
)
) attach://117172.gif 可以实现这样的效果 guosheyang 发表于 2021-12-13 11:40
attach://117172.gif 可以实现这样的效果
难点在旋转视图的时候，字符不动，而且您建立一个xy顺时针的ucs试试 哦 是指的文字一直显示在四角哈 那种效果不清楚 本帖最后由 guosheyang 于 2021-12-13 12:20 编辑
你是想要 这个控件标题文字 这种 一直显示在那儿哈 guosheyang 发表于 2021-12-13 12:19
你是想要 这个控件标题文字 这种 一直显示在那儿哈
差不多是这个意思 夏生生 发表于 2021-12-13 16:30
差不多是这个意思
是這種效果嗎?
滑鼠拖曳 文字都在 視口中心和四個角
滑鼠滾輪 可放大縮小字 同時 文字都在 視口中心和四個角