如何用vba在cad中实时显示角度的变化？

12QQQ

如题，在cad中画一个 ∠ ，旁边有文字显示角度值，如果选中角的顶点并移动鼠标，如何让文字实时的显示角度呢？

sealive_leafage

问题的难点在于在CAD中如何动态实时获得鼠标点的坐标，网上收集了些资料楼主可以体会一下；获得坐标值后则可以实现楼主要求的效果；详细参考：http://tiancao.net/blogview.asp?logID=214
CAD VBA实现橡皮筋直线、圆

首先是计时控件，然后是实时捕捉鼠标的屏幕位置，然后是转换获得CAD当前试图鼠标所在的位置坐标，然后才是实时绘制直线或圆。
) b' ?* F% ~" u( l! E# Z1 LVBA中不可直接使用vb的timer控件，我们可以调用独立的xTimer控件。
8 A- n+ b+ W* e7 l( |+ E5 |控件下载：
4 J" ^% b% ]# V1 @) z/ Z. ?http://www.tiancao.net/flashget.asp?dizhi=http://www.tiancao.net/attachments/month_0707/qnft_XTimers.rar
" V, ^0 g" T/ }" ]3 {
然后是使用API函数GetCursorPos获得当前鼠标的屏幕坐标。
然后通过读取CAD系统变量viewSize荷Screensize分别得到当前试图的CAD高度和当前视口的屏幕尺寸(屏幕分辨率的像素).然后得到CAD实际尺寸和屏幕像素的比值。
精确度于鼠标的频率快慢有关系

" V- H6 f  o" [# o! t'获取CAD坐标系统和屏幕像素的比值
Function ViewScreen() As Double
6 X8 X; e6 |3 ^' I    Dim ScreenSize As Variant
    ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
    Dim H As Variant
) g+ B- U6 x. q& [' \! R1 x    H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
! g4 U2 k4 h2 g( b: v; f, K1 O    ViewScreen = Abs(H / ScreenSize(1))
End Function
: x, P6 c, u9 n( [( t" dPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
1 Q6 S/ l' _+ E: N: h
$ Q& |1 p% s- M- A" i实时获得鼠标的屏幕坐标，然后通过屏幕尺寸和cad实际尺寸的比值，计算出鼠标当前的cad坐标。
7 F% g9 U0 i2 G2 T4 w然后在基点和鼠标坐标之间绘制直线或圆。
  ^; B- B2 h% P5 T/ h9 B6 e值得注意的是，屏幕坐标的是以屏幕的左上角为原点的。而cad的世界坐标是以右下角为原点的。
6 ?& z+ y! m: e
'得到鼠标屏幕坐标
: A. V, ?5 J) q, W) ?
4 K4 a+ d# W0 I, X0 p/ D% PPrivate Type POINTAPI
2 j8 b3 c$ z6 H; |/ o% n* ?* p    x As Long
    Y As Long
End Type
, ^! b8 m; l9 {Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim CAD_Point1 As Variant
Dim CAD_Point2 As Variant
3 q. S; p, y& m- z2 `Dim ScreenPoint1 As POINTAPI
Dim ScreenPoint2(1) As Long
1 [: V& Y- M. X$ ^: }$ z, TDim BiLi As Double
) u: [, \% q3 S'获取CAD坐标系统和屏幕像素的比值
$ ]1 `8 H5 ~3 p0 e) t  aFunction ViewScreen() As Double
. g0 O: L1 S* t' m4 h    Dim ScreenSize As Variant
, f) N( W- t. O6 [0 ]. n) O$ C8 m    ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
; H& W8 a' u* k" B    Dim H As Variant
    H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
$ r" T" }7 h3 S    ViewScreen = Abs(H / ScreenSize(1))
End Function
'通过CAD坐标计算屏幕坐标
Sub GetScreenPoint()
" j; n! V, X, e( V: ^0 K# Z6 v    BiLi = ViewScreen
+ E5 w7 y  H: a5 h- [) \/ r    CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
4 X3 ^0 F8 n, K! V7 i' O1 S" A5 i* H    ThisDrawing.ModelSpace.AddPoint CAD_Point1
' Z3 a' {- o6 f5 m1 u5 V0 I+ v    GetCursorPos ScreenPoint1   '通过api直接获得鼠标所在位置的屏幕坐标
    MsgBox "屏幕坐标：" & ScreenPoint1.x & " / " & ScreenPoint1.Y
    MsgBox "对应的CAD坐标：" & CAD_Point1(0) & " / " & CAD_Point1(1)
    '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
   
    CAD_Point2 = ThisDrawing.Utility.GetPoint(CAD_Point1, "指定下一点,这个点将通过计算得到屏幕坐标:")
+ W3 y" e6 ]( e3 V5 _9 f) ^   
% W0 n( v9 J/ V    ScreenPoint2(0) = Int(ScreenPoint1.x + (CAD_Point2(0) - CAD_Point1(0)) / BiLi)
  m! m9 f5 C. |    ScreenPoint2(1) = Int(ScreenPoint1.Y - (CAD_Point2(1) - CAD_Point1(1)) / BiLi)
$ ]4 t, z2 a% ^6 }) g    MsgBox "屏幕坐标：" & ScreenPoint2(0) & " / " & ScreenPoint2(1)
    '为了验证计算坐标，将CAD窗口在屏幕上移动到该点，看看效果吧。
+ i6 L  F9 [/ A; g# e1 k: v    ThisDrawing.Application.WindowState = acNorm
/ {2 l8 x- A: a/ d8 A# S4 k" n    ThisDrawing.Application.WindowLeft = ScreenPoint2(0)
    ThisDrawing.Application.WindowTop = ScreenPoint2(1)
   
   
End Sub
'   通过屏幕坐标计算CAD坐标
& n% k+ j4 j: XSub GetCAD_Point()
    BiLi = ViewScreen
    CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
9 f- A8 d; g, ~* O! p9 R+ N    ThisDrawing.ModelSpace.AddPoint CAD_Point1
    GetCursorPos ScreenPoint1   '通过api直接获得鼠标所在位置的屏幕坐标
$ X8 u, z1 g* ?. C; ]1 f7 L6 d    MsgBox "屏幕坐标：" & ScreenPoint1.x & " / " & ScreenPoint1.Y
/ l9 y# p: n% r# a7 p" q5 W8 K    MsgBox "对应的CAD坐标：" & CAD_Point1(0) & " / " & CAD_Point1(1)
    '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
   
( K# _( M9 x5 M) z    Dim ScreenPoint3 As POINTAPI
    GetCursorPos ScreenPoint3
( F2 J/ f3 {' v5 b1 _   
* E6 z# ]4 S7 s4 l; S+ k5 W    Dim CAD_Point3(2) As Double
3 Y* ]" r$ \  |1 k2 C    '计算cad坐标
    CAD_Point3(0) = CAD_Point1(0) + BiLi * (ScreenPoint3.x - ScreenPoint1.x)
    CAD_Point3(1) = CAD_Point1(1) - BiLi * (ScreenPoint3.Y - ScreenPoint1.Y)
    CAD_Point3(2) = 0
    MsgBox "屏幕坐标：" & CAD_Point3(0) & " / " & CAD_Point3(1)
9 Q6 g: _6 ]8 @& D% N) h6 m. m7 j. l    '为了验证计算坐标，将画一条直线，看看效果吧。
2 Y, C& z, _0 ]4 c; Y4 Y    ThisDrawing.ModelSpace.AddLine CAD_Point1, CAD_Point3
End Sub

12QQQ

非常感谢你！我要把你讲的好好消化消化！！