田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID

评论列表

所有评论
[74] [75] [76] [77] [78] [79] [80] [81] [82] [83]  ... [143]  
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 发表评论:
hbqall@163.com
发给我谢谢  急用
查看所评论的日志: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 发表评论:
按此在新窗口打开图片 

两年三个月1000万
查看所评论的日志:田草日志
xinxin 于 2009-05-06 06:33 PM 发表评论:
这个程序不错,能否提供下载或发一份btping@163.com,谢谢
查看所评论的日志:本站显示ip地址代码
[74] [75] [76] [77] [78] [79] [80] [81] [82] [83]  ... [143]  
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©