|
|
发表于 2010-1-23 12:34:45
|
显示全部楼层
来自: 中国浙江宁波
本帖最后由 sealive_leafage 于 2010-1-23 12:37 编辑
- h, H8 B- b+ n$ q1 B7 G$ {
1 H! |- h+ n* P* w问题的难点在于在CAD中如何动态实时获得鼠标点的坐标,网上收集了些资料楼主可以体会一下;获得坐标值后则可以实现楼主要求的效果;详细参考:http://tiancao.net/blogview.asp?logID=214) p, I( _; V' k t( P0 i! K
CAD VBA实现橡皮筋直线、圆& {! \1 _9 F& o" R0 t
! i& w& K! e7 y
首先是计时控件,然后是实时捕捉鼠标的屏幕位置,然后是转换获得CAD当前试图鼠标所在的位置坐标,然后才是实时绘制直线或圆。5 C+ f4 {' W; d2 D7 o! S- L+ ~
VBA中不可直接使用vb的timer控件,我们可以调用独立的xTimer控件。4 J! J8 r/ C9 n7 B
控件下载: . ]+ _, g& z! o& e& x6 q
http://www.tiancao.net/flashget.asp?dizhi=http://www.tiancao.net/attachments/month_0707/qnft_XTimers.rar
. n* _4 h& m# `0 W
% O# t, e# f+ \) ^2 {, s/ T然后是使用API函数GetCursorPos获得当前鼠标的屏幕坐标。
6 e7 v: T* S& n" f* j然后通过读取CAD系统变量viewSize荷Screensize分别得到当前试图的CAD高度和当前视口的屏幕尺寸(屏幕分辨率的像素).然后得到CAD实际尺寸和屏幕像素的比值。' h) E9 r1 f n+ u. g& A# C
精确度于鼠标的频率快慢有关系
) L" A) X& F" V5 v3 w/ U8 J: ]8 b- _ x
'获取CAD坐标系统和屏幕像素的比值
. k6 k$ Z: J! K! O j, E! MFunction ViewScreen() As Double
* W* V. O1 y6 G7 b u+ P$ e. \ Dim ScreenSize As Variant+ \# I0 r8 |& J) {' Y7 R4 S. [
ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度9 F) q- e1 \: D4 L- _, e4 e
Dim H As Variant
, }: g4 ^+ O/ I0 W; L: _' \7 ` H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度
0 d3 Z# Q% V4 t* ]$ z+ }/ E1 z ViewScreen = Abs(H / ScreenSize(1))+ x3 T3 y& _4 \" h' ^
End Function9 C( M, Y4 Y, `, Y$ s! m
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
6 O6 V8 _; O* c6 _% M% l
5 M: k' b- [6 D, I' Y g实时获得鼠标的屏幕坐标,然后通过屏幕尺寸和cad实际尺寸的比值,计算出鼠标当前的cad坐标。
" D8 Q8 v! v' Z% S然后在基点和鼠标坐标之间绘制直线或圆。
( m7 P4 k9 G: N0 A值得注意的是,屏幕坐标的是以屏幕的左上角为原点的。而cad的世界坐标是以右下角为原点的。# {8 M9 u$ }5 h& Q
* C1 _- Z% K( @. X/ J4 e7 I
'得到鼠标屏幕坐标- t w, l, @2 G! z! r+ r6 T
, ]/ d8 |# u# A. t4 v, xPrivate Type POINTAPI
* u5 D+ [1 H+ l2 `# Y: s/ _) m x As Long
# Q: G8 `4 c1 j3 D5 u2 k6 s0 k5 z Y As Long' O+ Y" y7 `: Z+ _, \/ s
End Type( a9 v# |/ e: [2 c8 v# {
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long& _2 ]! X5 C9 L6 \: p3 [
Dim CAD_Point1 As Variant2 P$ e& T- B; k$ }( Z& E1 u
Dim CAD_Point2 As Variant3 I. `* n8 @5 m& Q
Dim ScreenPoint1 As POINTAPI* J6 v c! ?7 N6 e$ H1 S
Dim ScreenPoint2(1) As Long- N5 X" t9 M5 h3 X3 r6 M
Dim BiLi As Double4 Z$ O( t* B( I7 H
'获取CAD坐标系统和屏幕像素的比值 [* R4 X# d: h
Function ViewScreen() As Double9 O8 Z( f% k( f( i
Dim ScreenSize As Variant
3 s0 _4 X9 H! C& B' M! b ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度
$ W3 y' Z- R& @7 i! N) s Dim H As Variant
& L6 \0 Z1 e" z6 E' H+ c! q3 q H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度- h1 a# l) p/ l
ViewScreen = Abs(H / ScreenSize(1))
. m& ?/ k8 n! m8 @4 n5 j7 {End Function
$ }/ _" y' Z3 Q+ C! `'通过CAD坐标计算屏幕坐标8 t* @6 b' G! j6 @- O
Sub GetScreenPoint()2 e# {6 c$ m! h: j
BiLi = ViewScreen
( l* i0 G6 W/ L CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
- m6 V" A' e. M8 p3 V* Z. D ThisDrawing.ModelSpace.AddPoint CAD_Point1
5 @; b! k l6 N2 Y4 V- t GetCursorPos ScreenPoint1 '通过api直接获得鼠标所在位置的屏幕坐标
' F6 V2 x6 { D F) ]( j8 q MsgBox "屏幕坐标:" & ScreenPoint1.x & " / " & ScreenPoint1.Y C0 U( L2 B7 `0 t9 ?$ C( ]5 {! l
MsgBox "对应的CAD坐标:" & CAD_Point1(0) & " / " & CAD_Point1(1)
. D( }1 V2 n( N! R/ y '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了
$ u$ Q' |8 V9 U. |5 v$ e
' s$ W. [* |1 D1 B& g6 m, ?* h+ X2 \ CAD_Point2 = ThisDrawing.Utility.GetPoint(CAD_Point1, "指定下一点,这个点将通过计算得到屏幕坐标:")1 l8 w# f0 F* E7 Q- j
! O/ m0 K$ g1 }& f ScreenPoint2(0) = Int(ScreenPoint1.x + (CAD_Point2(0) - CAD_Point1(0)) / BiLi)
3 R, Y" G3 f0 z: M& a ScreenPoint2(1) = Int(ScreenPoint1.Y - (CAD_Point2(1) - CAD_Point1(1)) / BiLi)
: Z/ |" t) W1 n: R MsgBox "屏幕坐标:" & ScreenPoint2(0) & " / " & ScreenPoint2(1)
* x5 t* w( \. I7 b ^- j/ `+ I '为了验证计算坐标,将CAD窗口在屏幕上移动到该点,看看效果吧。
/ O/ W, R" V/ x# \ ThisDrawing.Application.WindowState = acNorm
# k9 H6 P: M. {1 \5 X7 g) d- N) l ThisDrawing.Application.WindowLeft = ScreenPoint2(0)8 i3 |2 j( `6 m1 l B2 B
ThisDrawing.Application.WindowTop = ScreenPoint2(1) ~+ R) Q3 l& i6 [. }
l. l o; P1 v; K) z+ V# k$ G ( ]/ O( b2 a8 ^& F% z% o
End Sub
& D& D: _2 ^& a' 通过屏幕坐标计算CAD坐标. S3 Q( L7 i' P% I. ?8 d- X2 K* x& [
Sub GetCAD_Point()
+ Z' S. n" ?7 p, l) T: [1 z. L BiLi = ViewScreen
0 @5 I2 o$ L* C, v4 b4 Y CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标
* v" j% r9 J. \0 b/ D( p3 p ThisDrawing.ModelSpace.AddPoint CAD_Point1
) @1 Y9 h/ { T9 G# V; r8 Y GetCursorPos ScreenPoint1 '通过api直接获得鼠标所在位置的屏幕坐标
( I9 v' m# \9 ^3 r; l+ B MsgBox "屏幕坐标:" & ScreenPoint1.x & " / " & ScreenPoint1.Y
% H; R) L! T9 ?. |6 { MsgBox "对应的CAD坐标:" & CAD_Point1(0) & " / " & CAD_Point1(1)
! L3 Q& C( E$ X) |) G5 d) U# L8 F '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了" h! m' o' D7 v% |
. `; j/ z9 o5 y! M' G" M. T
Dim ScreenPoint3 As POINTAPI( Q/ N/ B) s4 i- o
GetCursorPos ScreenPoint3
' @' [" e' b' }, I # h7 [1 k. w; N" e
Dim CAD_Point3(2) As Double4 R$ l- ~3 O: i6 X
'计算cad坐标* A' h/ g- X8 E
CAD_Point3(0) = CAD_Point1(0) + BiLi * (ScreenPoint3.x - ScreenPoint1.x)
* A' k; d; p* J CAD_Point3(1) = CAD_Point1(1) - BiLi * (ScreenPoint3.Y - ScreenPoint1.Y)( V* U4 V: D# Z2 C! C1 H9 k; o
CAD_Point3(2) = 0
( Z5 A+ y, ? K5 j MsgBox "屏幕坐标:" & CAD_Point3(0) & " / " & CAD_Point3(1)( ~7 `+ `" i( V9 Z& s' E* r7 P
'为了验证计算坐标,将画一条直线,看看效果吧。/ }" Q# p* y+ ~/ ?% s$ C& X
ThisDrawing.ModelSpace.AddLine CAD_Point1, CAD_Point3" Y# s$ M; H( W. ^# G% s9 x; V
End Sub |
-
评分
-
查看全部评分
|