liuchang.555 于 2009-05-13 02:13 PM 发表评论: |
|
查看所评论的日志:CAD VBA实现橡皮筋直线、圆 |
liuchang.555 于 2009-05-13 02:12 PM 发表评论: |
|
查看所评论的日志:CAD VBA实现橡皮筋直线、圆 |
hbqall 于 2009-05-13 01:31 PM 发表评论: |
|
查看所评论的日志:AutoCAD VBA 二次开发教程源码 |
tiancao1001 于 2009-05-13 09:51 AM 发表评论: |
'得到鼠标屏幕坐标
Private Type POINTAPI x As Long Y As Long End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim CAD_Point1 As Variant Dim CAD_Point2 As Variant Dim ScreenPoint1 As POINTAPI Dim ScreenPoint2(1) As Long Dim BiLi As Double '获取CAD坐标系统和屏幕像素的比值 Function ViewScreen() As Double Dim ScreenSize As Variant ScreenSize = ThisDrawing.GetVariable("screensize") '当前视口的屏幕宽度和高度 Dim H As Variant H = ThisDrawing.GetVariable("viewsize") '当前视图图形的实际高度 ViewScreen = Abs(H / ScreenSize(1)) End Function '通过CAD坐标计算屏幕坐标 Sub GetScreenPoint()
BiLi = ViewScreen CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标 ThisDrawing.ModelSpace.AddPoint CAD_Point1 GetCursorPos ScreenPoint1 '通过api直接获得鼠标所在位置的屏幕坐标 MsgBox "屏幕坐标:" & ScreenPoint1.x & " / " & ScreenPoint1.Y MsgBox "对应的CAD坐标:" & CAD_Point1(0) & " / " & CAD_Point1(1) '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了 CAD_Point2 = ThisDrawing.Utility.GetPoint(CAD_Point1, "指定下一点,这个点将通过计算得到屏幕坐标:") ScreenPoint2(0) = Int(ScreenPoint1.x + (CAD_Point2(0) - CAD_Point1(0)) / BiLi) ScreenPoint2(1) = Int(ScreenPoint1.Y - (CAD_Point2(1) - CAD_Point1(1)) / BiLi) MsgBox "屏幕坐标:" & ScreenPoint2(0) & " / " & ScreenPoint2(1) '为了验证计算坐标,将CAD窗口在屏幕上移动到该点,看看效果吧。 ThisDrawing.Application.WindowState = acNorm ThisDrawing.Application.WindowLeft = ScreenPoint2(0) ThisDrawing.Application.WindowTop = ScreenPoint2(1) End Sub ' 通过屏幕坐标计算CAD坐标 Sub GetCAD_Point() BiLi = ViewScreen CAD_Point1 = ThisDrawing.Utility.GetPoint(, "先指定一个点:") '获得鼠标所在位置的CAD坐标 ThisDrawing.ModelSpace.AddPoint CAD_Point1 GetCursorPos ScreenPoint1 '通过api直接获得鼠标所在位置的屏幕坐标 MsgBox "屏幕坐标:" & ScreenPoint1.x & " / " & ScreenPoint1.Y MsgBox "对应的CAD坐标:" & CAD_Point1(0) & " / " & CAD_Point1(1) '以上获得了CAD坐标和屏幕坐标的对应关系,下面就可以计算了 Dim ScreenPoint3 As POINTAPI GetCursorPos ScreenPoint3 Dim CAD_Point3(2) As Double '计算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) '为了验证计算坐标,将画一条直线,看看效果吧。 ThisDrawing.ModelSpace.AddLine CAD_Point1, CAD_Point3 End Sub
|
|
查看所评论的日志:CAD VBA实现橡皮筋直线、圆 |
liuchang.555 于 2009-05-12 04:37 PM 发表评论: |
请问有没有cad坐标转换为windows屏幕坐标的例子,劳驾给一个好吗。邮箱:c.liu@kimoto.com.cn。多谢了。 |
|
查看所评论的日志:CAD VBA实现橡皮筋直线、圆 |
zjx1975 于 2009-05-08 10:39 PM 发表评论: |
能发一份给我么 zjx1975@126.com 谢谢了 |
|
查看所评论的日志:AutoCAD vba 开发人员手册 |
tiancao1001 于 2009-05-06 07:46 PM 发表评论: |
|
查看所评论的日志:田草日志 |
xinxin 于 2009-05-06 06:33 PM 发表评论: |
这个程序不错,能否提供下载或发一份btping@163.com,谢谢 |
|
查看所评论的日志:本站显示ip地址代码 |