如何让当前视口中心和四个角点显示特定字符（高飞鸟版主能有空指导更好）

夏生生 · 发表于 2021-12-12 13:01

本帖最后由夏生生于 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
)
(setq loop 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)
)
)

(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 
        ) 
  (setq  loop 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-12 13:01

本帖最后由 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
)
(setq loop 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)
)
)

(defun c:temp (/   CEN     D2W       GR1       GR2 
         H   LOOP     OBJL       PT         SC 
         SCR   STR     WB       WH         temp 
        ) 
  (setq  loop 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) 
  ) 
)

guosheyang · 发表于 2021-12-13 11:27

grread函数下不是很懂但是在任意视图包括旋转后的三维视图状态下只要改为视图ucs 在屏幕四角和中心显示固定大小的文字应该是可以实现的

夏生生 · 发表于 2021-12-13 11:37

本帖最后由夏生生于 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)
)
)

guosheyang · 发表于 2021-12-13 11:40

http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTE3MTcyfGVkOGJiYTQzMjE0MDYxMzdlMThjMDA2N2ZiNTdiMmExfDE3MTUxMDU5MDU%3D&request=yes&_f=.gif 可以实现这样的效果

夏生生 · 发表于 2021-12-13 11:45

guosheyang 发表于 2021-12-13 11:40
http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTE3MTcyfGVkOGJiYTQzMjE0MDYxMzdlMThjMDA2N2ZiNTdiMmExfDE3MTUxMDU5MDU%3D&request=yes&_f=.gif 可以实现这样的效果

难点在旋转视图的时候，字符不动，而且您建立一个xy顺时针的ucs试试

guosheyang · 发表于 2021-12-13 11:51

哦是指的文字一直显示在四角哈那种效果不清楚

guosheyang · 发表于 2021-12-13 12:19

本帖最后由 guosheyang 于 2021-12-13 12:20 编辑

你是想要这个控件标题文字这种一直显示在那儿哈

夏生生 · 发表于 2021-12-13 16:30

guosheyang 发表于 2021-12-13 12:19
你是想要这个控件标题文字这种一直显示在那儿哈

差不多是这个意思

lee50310 · 发表于 2021-12-14 18:50

夏生生发表于 2021-12-13 16:30
差不多是这个意思

是這種效果嗎?

滑鼠拖曳文字都在視口中心和四個角
滑鼠滾輪可放大縮小字同時文字都在視口中心和四個角

账号		自动登录	找回密码
密码			注册

[提问] 如何让当前视口中心和四个角点显示特定字符（高飞鸟版主能有空指导更好）

最佳答案

评分

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

点评

评分