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

12QQQ

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

sealive_leafage

问题的难点在于在CAD中如何动态实时获得鼠标点的坐标，网上收集了些资料楼主可以体会一下；获得坐标值后则可以实现楼主要求的效果；详细参考：http://tiancao.net/blogview.asp?logID=214
3 A- D( S% x7 {3 m5 R. ^CAD VBA实现橡皮筋直线、圆
7 Y. W: n/ \/ E0 [
# W2 y2 n: F$ s% X8 k首先是计时控件，然后是实时捕捉鼠标的屏幕位置，然后是转换获得CAD当前试图鼠标所在的位置坐标，然后才是实时绘制直线或圆。
VBA中不可直接使用vb的timer控件，我们可以调用独立的xTimer控件。
3 l, k7 P5 t3 {0 ^( j3 F% A控件下载：
http://www.tiancao.net/flashget.asp?dizhi=http://www.tiancao.net/attachments/month_0707/qnft_XTimers.rar

然后是使用API函数GetCursorPos获得当前鼠标的屏幕坐标。
然后通过读取CAD系统变量viewSize荷Screensize分别得到当前试图的CAD高度和当前视口的屏幕尺寸(屏幕分辨率的像素).然后得到CAD实际尺寸和屏幕像素的比值。
精确度于鼠标的频率快慢有关系

'获取CAD坐标系统和屏幕像素的比值
: n% E# u( b/ U" zFunction ViewScreen() As Double
    Dim ScreenSize As Variant
    ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
    Dim H As Variant
    H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
    ViewScreen = Abs(H / ScreenSize(1))
+ z! c: D9 I) n' w5 }2 @  lEnd Function
. r1 N' y3 [% t( T- DPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

, [1 y8 j; J5 a; h3 v$ T5 D! a1 a实时获得鼠标的屏幕坐标，然后通过屏幕尺寸和cad实际尺寸的比值，计算出鼠标当前的cad坐标。
然后在基点和鼠标坐标之间绘制直线或圆。
值得注意的是，屏幕坐标的是以屏幕的左上角为原点的。而cad的世界坐标是以右下角为原点的。
* S7 C* p5 ^# k2 N, i1 f
( Q5 R$ j! I5 A* s. N'得到鼠标屏幕坐标
9 K4 H$ F, a7 m) ^
- E' v: g( m/ R6 i( ^! o1 hPrivate Type POINTAPI
) v. o, C- \7 ^5 Z0 p+ e8 Q    x As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim CAD_Point1 As Variant
7 R4 p8 P* {, {" Q2 v2 I, K7 N( lDim CAD_Point2 As Variant
Dim ScreenPoint1 As POINTAPI
Dim ScreenPoint2(1) As Long
5 |& N+ P# g/ n7 E) X( tDim BiLi As Double
'获取CAD坐标系统和屏幕像素的比值
$ n# |  t+ N% O. F& Q# X: b* Y& i4 ]$ |; FFunction ViewScreen() As Double
  U% }; L- j* l/ {. s& {: e    Dim ScreenSize As Variant
. }& k4 Q$ Y! y8 f; x5 I0 Z    ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
    Dim H As Variant
    H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
    ViewScreen = Abs(H / ScreenSize(1))
End Function
'通过CAD坐标计算屏幕坐标
Sub GetScreenPoint()
0 o8 H' ~/ Z: c    BiLi = ViewScreen
    CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
    ThisDrawing.ModelSpace.AddPoint CAD_Point1
4 W8 d8 e+ {2 c/ Q2 ^! @6 F0 u+ D2 R    GetCursorPos ScreenPoint1   '通过api直接获得鼠标所在位置的屏幕坐标
+ v9 @* E% I  f) C1 k    MsgBox "屏幕坐标：" & ScreenPoint1.x & " / " & ScreenPoint1.Y
7 B$ D/ G1 p0 D! J/ g    MsgBox "对应的CAD坐标：" & CAD_Point1(0) & " / " & CAD_Point1(1)
, m5 J$ F1 q) l. o; b9 J    '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
   
/ a7 c* y% F5 N( H; z; c    CAD_Point2 = ThisDrawing.Utility.GetPoint(CAD_Point1, "指定下一点,这个点将通过计算得到屏幕坐标:")
   
- s, ~7 J- a6 F2 F/ v8 R    ScreenPoint2(0) = Int(ScreenPoint1.x + (CAD_Point2(0) - CAD_Point1(0)) / BiLi)
2 Q9 ?; h& B' Q% U, K    ScreenPoint2(1) = Int(ScreenPoint1.Y - (CAD_Point2(1) - CAD_Point1(1)) / BiLi)
) R+ [% R; ~; F9 u$ ?2 F8 a7 T) w    MsgBox "屏幕坐标：" & ScreenPoint2(0) & " / " & ScreenPoint2(1)
    '为了验证计算坐标，将CAD窗口在屏幕上移动到该点，看看效果吧。
    ThisDrawing.Application.WindowState = acNorm
- k+ Y& H1 D: Y" w7 ]5 F, {! m! f    ThisDrawing.Application.WindowLeft = ScreenPoint2(0)
8 d  ~% K. t! E% \% r: d& E    ThisDrawing.Application.WindowTop = ScreenPoint2(1)
   
   
End Sub
# S3 w1 ]8 B3 L, h$ c'   通过屏幕坐标计算CAD坐标
Sub GetCAD_Point()
  W8 V8 g9 F( d/ i; D% b; |    BiLi = ViewScreen
    CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
& H4 H) V6 F! _* }5 W4 e9 H  d    ThisDrawing.ModelSpace.AddPoint CAD_Point1
    GetCursorPos ScreenPoint1   '通过api直接获得鼠标所在位置的屏幕坐标
' p% ~1 t: Z3 Y1 ^: K% b0 i" H    MsgBox "屏幕坐标：" & ScreenPoint1.x & " / " & ScreenPoint1.Y
    MsgBox "对应的CAD坐标：" & CAD_Point1(0) & " / " & CAD_Point1(1)
    '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
   
  ~* M0 Z8 S. F! e1 E$ q    Dim ScreenPoint3 As POINTAPI
    GetCursorPos ScreenPoint3
   
) U0 i. h! \4 O5 r9 m  q0 k    Dim CAD_Point3(2) As Double
    '计算cad坐标
    CAD_Point3(0) = CAD_Point1(0) + BiLi * (ScreenPoint3.x - ScreenPoint1.x)
) ], ~7 g# I, k( G2 p    CAD_Point3(1) = CAD_Point1(1) - BiLi * (ScreenPoint3.Y - ScreenPoint1.Y)
8 n  S% ?9 A5 _8 _    CAD_Point3(2) = 0
2 `" q! W, N2 x! `; I    MsgBox "屏幕坐标：" & CAD_Point3(0) & " / " & CAD_Point3(1)
    '为了验证计算坐标，将画一条直线，看看效果吧。
    ThisDrawing.ModelSpace.AddLine CAD_Point1, CAD_Point3
End Sub

12QQQ

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