[原创]利用Excel的VBA控制AutoCAD

feye

本人刚开始研究ACAD,发现从Excel中控制CAD有很多好处.

相信这是一本VBA初学者的很好参考,因为本人就是初学者啊,请高手们多指点啊

本文以实际应用开发为例程，希望大家共同来发表和学习

先从最初开始吧

Public Sub acadInit()
    'ACAD2007的编程接口
    Dim cap As String, caver As String
    cap = "AutoCAD.Application"
    caver = cadVer() '通过读取注册表获得当前安装的AutoCAD版本号
    If caver = "R17.0" Then
        cap = cap + ".17"
    End If
    On Error Resume Next
    Set acadApp = GetObject(, cap)
    If Err Then
        Err.Clear
        Set acadApp = CreateObject(cap)
        If Err Then
            MsgBox Err.Description
            Exit Sub
        End If
    End If
    Set acadDoc = acadApp.ActiveDocument
End Sub

 

[em39][em39][em39][em39][em39][em39][em39]

 [em39][em39][em39][em39]

[此贴子已经被作者于2006-7-21 11:58:03编辑过]

来生缘

没装AUTOCAD,做什么用的?绘图的?

多谢分享

feye

 

上传CADVer函数供大家讨论

Public Const HKEY_CURRENT_USER = &H80000001
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Public Function cadVer() As String
    '返回AutoCAD的版本号

    Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
    Dim Name As String, s As String
    ret = RegOpenKey(HKEY_CURRENT_USER, "Software\Autodesk\AutoCAD", hKey)
    If ret <> 0 Then
        MsgBox "AutoCAD程序安装不正确"
        Exit Function
    End If
    Name = "CurVer"
    ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
    s = String(lenData, Chr(0))
    ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal s, lenData)
    cadVer = Left(s, InStr(s, Chr(0)) - 1)
    RegCloseKey hKey
End Function

[em08][em10]

feye

AutoCAD是风靡全球的绘图软件,是当代建造师的首选武器。

feye

我们来绘制第一条直线

Public Function LWLine(ar() As Pointf) As AcadLWPolyline
    '采用ar()点列表绘制多段线
    Set LWLine = acadDoc.ModelSpace. _
                   AddLightWeightPolyline(CPPL(ar))
End Function
由于本人对CAD中的点列表不满意,故私自定义了一个点类型Pointf

Public Type Pointf
    i As Integer '点的编号从零开始
    x As Double '点的X坐标
    y As Double '点的Y坐标
End Type

feye

上传CPPL函数

Private Function CPPL(ar() As Pointf) As Double()
    '该函数转换Pointf类型为AutoCAD可识别的多点列表
    Dim i As Integer, n As Integer
    Dim ars() As Double
    n = UBound(ar)
    ReDim ars(2 * n + 1)
    For i = 0 To n
        ars(2 * i) = ar(i).x
        ars(2 * i + 1) = ar(i).y
    Next i
    CPPL = ars
End Function

feye

LpAdd函数

Public Function LpAdd(ar() As Pointf, pp As Pointf) As Pointf()
    '给点表数组ar()的每一点坐标分别对应加上PP点的坐标并返回新点表数组
    Dim i As Integer
    Dim lp() As Pointf
    m = UBound(ar)
    ReDim lp(m)
    For i = 0 To m
        lp(i).i = i
        lp(i).x = pp.x + ar(i).x
        lp(i).y = pp.y + ar(i).y
    Next i
    LpAdd = lp
End Function

[em10]

feye

LpSub函数

Public Function LpSub(ar() As Pointf, pp As Pointf) As Pointf()
    '适应左侧坐标系转换
    '给点表数组ar()的每一点坐标Y分别对应加上PP点的坐标Y
    'PP点的坐标Y减去数组ar()的每一点坐标X并返回新点表数组
    Dim i As Integer
    Dim lp() As Pointf
    m = UBound(ar)
    ReDim lp(m)
    For i = 0 To m
        lp(i).i = i
        lp(i).x = pp.x - ar(i).x
        lp(i).y = pp.y + ar(i).y
    Next i
    LpAdd = lp
End Function

feye

本人很想得到大家的支持,请大家提出自己的意见

 

[em03][em03][em03][em03][em03][em03][em03]

feye

AutoCAD是风靡全球的绘图软件,几乎工科学生都开设了这门课程,在网上很轻松找到免费软件的,功能之强大,望大家都来参与!

 

 

 

 

[em39][em39][em39][em39][em39]

[em39][em39][em39][em39]