|
|
发表于 2010-1-23 12:34:45
|
显示全部楼层
来自: 中国浙江宁波
本帖最后由 sealive_leafage 于 2010-1-23 12:37 编辑 ' O; }, z) v% Z* h5 g) ]$ ~5 z, K
5 U6 D5 m) L- M8 E
问题的难点在于在CAD中如何动态实时获得鼠标点的坐标,网上收集了些资料楼主可以体会一下;获得坐标值后则可以实现楼主要求的效果;详细参考:http://tiancao.net/blogview.asp?logID=214$ b9 }0 K+ h) E3 N& Q/ |! m
CAD VBA实现橡皮筋直线、圆
, q& X' u$ t- @# p
. Q! n0 E3 i1 Z3 p# H( {; G9 {( R首先是计时控件,然后是实时捕捉鼠标的屏幕位置,然后是转换获得CAD当前试图鼠标所在的位置坐标,然后才是实时绘制直线或圆。
+ C1 x D" C2 Z+ x& t* X; t) g4 NVBA中不可直接使用vb的timer控件,我们可以调用独立的xTimer控件。3 K. w& p% f: D# W' K, K
控件下载:
3 K5 J; [, f- c3 Vhttp://www.tiancao.net/flashget.asp?dizhi=http://www.tiancao.net/attachments/month_0707/qnft_XTimers.rar
, i9 x: {/ ]" v! i
9 s8 J% N, t7 C+ k' [然后是使用API函数GetCursorPos获得当前鼠标的屏幕坐标。
& S. ~ u5 l6 K8 W5 K然后通过读取CAD系统变量viewSize荷Screensize分别得到当前试图的CAD高度和当前视口的屏幕尺寸(屏幕分辨率的像素).然后得到CAD实际尺寸和屏幕像素的比值。
/ }' z$ X- S1 a' O0 v$ y精确度于鼠标的频率快慢有关系/ o" a( Z/ D: n$ }5 P
- o$ E8 [% j4 q# }7 n0 I9 X$ j B'获取CAD坐标系统和屏幕像素的比值
0 Z9 ~: H- F1 {" O% E7 e8 ^Function ViewScreen() As Double& h7 Z _3 w5 z1 y
Dim ScreenSize As Variant" d7 @- X) {+ A9 |2 |
ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
1 ^ L5 m( \" W+ e9 @" N5 |& ` Dim H As Variant
- ~9 `0 r* |& ?$ } H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
6 h* r7 N3 Z& o' Q+ d; c ViewScreen = Abs(H / ScreenSize(1))4 W4 o" R! S& d
End Function
; z! {( m; _0 W, ~4 A kPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long- O$ S* m# T( A8 M
. T4 A2 s5 A" g9 n实时获得鼠标的屏幕坐标,然后通过屏幕尺寸和cad实际尺寸的比值,计算出鼠标当前的cad坐标。
7 ]8 z1 Q. q) j) ^6 c M3 M然后在基点和鼠标坐标之间绘制直线或圆。0 L [8 s' c; e( j9 @1 h" b9 b
值得注意的是,屏幕坐标的是以屏幕的左上角为原点的。而cad的世界坐标是以右下角为原点的。
- r- F" i6 b4 ]& ^ D, X4 c
; H' K& m7 J5 h J# B'得到鼠标屏幕坐标
! h1 s+ I" {7 E+ x5 N. m4 M. J' B; d1 ^
Private Type POINTAPI
! B5 `* x7 N1 q4 C5 v+ h l x As Long, g- T* c( K# u
Y As Long8 q) [) ~' x1 L9 b* ]
End Type, m& t% ^: X0 N; @% b4 ^( V
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long4 g/ j6 j; i4 t
Dim CAD_Point1 As Variant" `2 A1 I- D: @
Dim CAD_Point2 As Variant
' j% G% M% {7 q) KDim ScreenPoint1 As POINTAPI
. ?+ ^( t0 K O2 F* bDim ScreenPoint2(1) As Long: _# B$ u% p/ Q
Dim BiLi As Double
: w% I d" D+ @* S" e1 K'获取CAD坐标系统和屏幕像素的比值
' v5 ]8 t, Q0 t) t, k9 dFunction ViewScreen() As Double: K$ n7 t$ ^: e. Z; l+ j9 \
Dim ScreenSize As Variant
; I% ^3 |1 I k6 z- f: e. y ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度( t( t* ?% s( T6 \
Dim H As Variant' p) F7 W- c/ Q: }. \9 [
H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
- F0 o6 u: I- j3 I: s" \. U; K. | ViewScreen = Abs(H / ScreenSize(1))/ i# T4 G( y* I0 _
End Function
0 M& [/ l" M) d* E'通过CAD坐标计算屏幕坐标3 R3 l9 G2 j% |7 _/ Z1 o/ w% ~
Sub GetScreenPoint()
* w: F& @% ~! u, g$ p0 _ BiLi = ViewScreen
1 r5 R( y8 F& I5 d8 W3 |# ] CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
* Z! y3 Q- S. l* c$ s; ] ThisDrawing.ModelSpace.AddPoint CAD_Point1
) u' X( Q3 Q# r' D8 ~ GetCursorPos ScreenPoint1 '通过api直接获得鼠标所在位置的屏幕坐标
& C; S" U( L7 n/ h3 X" [ MsgBox "屏幕坐标:" & ScreenPoint1.x & " / " & ScreenPoint1.Y) i$ T k* s" j& h8 X. m4 K
MsgBox "对应的CAD坐标:" & CAD_Point1(0) & " / " & CAD_Point1(1)
" p$ M; M: `; k( ~ '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了7 W) V9 F$ `8 {* o! W/ l
3 J# O+ d V/ P& Y Z
CAD_Point2 = ThisDrawing.Utility.GetPoint(CAD_Point1, "指定下一点,这个点将通过计算得到屏幕坐标:")4 y; \% [+ `+ m( M
! s2 R" [0 W, h) ^ ScreenPoint2(0) = Int(ScreenPoint1.x + (CAD_Point2(0) - CAD_Point1(0)) / BiLi)
, g/ Y6 t- b) I ScreenPoint2(1) = Int(ScreenPoint1.Y - (CAD_Point2(1) - CAD_Point1(1)) / BiLi)
2 m& @# E M! M! n MsgBox "屏幕坐标:" & ScreenPoint2(0) & " / " & ScreenPoint2(1)" q1 S H5 o: U: b7 V3 k
'为了验证计算坐标,将CAD窗口在屏幕上移动到该点,看看效果吧。) l. B1 ~1 Q' @0 o; R' m# ?$ R
ThisDrawing.Application.WindowState = acNorm# c* y) x K" q2 h/ d" o1 X1 U
ThisDrawing.Application.WindowLeft = ScreenPoint2(0)9 b% h- P6 `/ Y5 x2 i7 q
ThisDrawing.Application.WindowTop = ScreenPoint2(1)$ Z0 @( H: P" m- `4 j% {; n- }
% L' j L! u2 t- ~ 3 i/ b: c# W% w* h5 D2 k) W
End Sub
2 c, E( ?- |) A* y' 通过屏幕坐标计算CAD坐标
8 ~" j8 J, m+ R( C9 o, OSub GetCAD_Point()
0 x; ~* S1 Y9 E4 H( N6 C9 ] BiLi = ViewScreen
7 C# c8 p: Y+ Q" O; c* d CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标* t, ]! j9 ]/ h |
ThisDrawing.ModelSpace.AddPoint CAD_Point1
/ v& W# ^* J( {* J$ o' p GetCursorPos ScreenPoint1 '通过api直接获得鼠标所在位置的屏幕坐标
# C5 A! \, _: L# S- L/ C4 Y \) G MsgBox "屏幕坐标:" & ScreenPoint1.x & " / " & ScreenPoint1.Y/ s; o: {2 f9 y
MsgBox "对应的CAD坐标:" & CAD_Point1(0) & " / " & CAD_Point1(1) W" {0 k6 Q$ x4 G% |
'以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了0 Z1 {% i: B5 [. h- A
% p1 o1 ]% z% O6 q! `+ q
Dim ScreenPoint3 As POINTAPI: j3 q4 c+ k9 e
GetCursorPos ScreenPoint3& `: @( e& C5 ]" }/ B
4 X4 U q7 n4 x& _+ i! X3 g/ g Dim CAD_Point3(2) As Double
- I% |7 G1 u, J7 t '计算cad坐标
4 a0 Q9 g" h9 m8 b! S& D: V+ B* C CAD_Point3(0) = CAD_Point1(0) + BiLi * (ScreenPoint3.x - ScreenPoint1.x)5 _; [$ K( `$ J2 `) Z. c
CAD_Point3(1) = CAD_Point1(1) - BiLi * (ScreenPoint3.Y - ScreenPoint1.Y)
+ @) c8 v* q4 n* q CAD_Point3(2) = 0$ W% Y2 w8 N8 w
MsgBox "屏幕坐标:" & CAD_Point3(0) & " / " & CAD_Point3(1)5 F) {% k( X$ R& f/ N: j
'为了验证计算坐标,将画一条直线,看看效果吧。
2 P' Z% y k i, i ThisDrawing.ModelSpace.AddLine CAD_Point1, CAD_Point3) U& Q9 ^: m) P2 b. g i! c
End Sub |
-
评分
-
查看全部评分
|