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

fan0217

这是OLE的典型应用

kailee

QUOTE:

以下是引用黄玉宏在2006-7-15 16:50:36的发言：

事实上，CAD可看作是Excel的高级绘图控件，其绘图功能是十分强大的，而且其自带了VBA，我们可以在Excel中读取数据或查询数据然后再将数据发送到CAD中进行绘图。亦可在CAD中直接读取Excel中数据，但该法不如前者，因CAD本身处理数据的功能太差。我就利用了Excel的强大的计算、查询及CAD的绘图功能自编了“多段线绘制公路横断面图”程序。两种软件的兼容性还是较好，值得学习。

黄玉宏

二○○六年七月十三日

徐光辉就有这个软件，专门绘制公路断面图的，连同支挡构造物也一次性准确地绘上去了，楼主在网上搜一下就可以找到。不妨把你的成果也发上来让大家分享？

!!!橄榄树

紫蝶儿菲菲:高手不少吧!只要你答话,就有人娶你,每个专业都有高手。

feye

LpTX()函数

Public Function LpTX(ar() As Pointf) As Pointf()
    '列表数组进行倒序
    Dim lp() As Pointf
    't = UBound(ar)
    On Error Resume Next
    t = UBound(ar)
    If Err.Number <> 0 Then
        LpTX = ar
        Err.Clear
        Exit Function
    End If
    ReDim lp(t)
    For i = 0 To t
        lp(i) = ar(t - i)
    Next i
    LpTX = lp
End Function

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

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

feye

LpApp()函数

Public Function LpApp(ar() As Pointf, pp As Pointf) As Pointf()
              '在点表数组ar()的末尾追加一个点PP,并返回插入的数组,并不修改ar()
               Dim t As Integer
               Dim lp() As Pointf
               On Error Resume Next
               t = UBound(ar)
               If Err.Number <> 0 Then
                   t = -1
                   Err.Clear
                   ReDim lp(0)
               Else
                   ReDim lp(t)
                   lp = ar
                   ReDim Preserve lp(t + 1)
               End If
               lp(t + 1) = pp
               lp(t + 1).i = t + 1
               LpApp = lp
      End Function

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

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

feye

 LpSam()函数

Public Function LpSam(ar() As Pointf, fir As Integer, las As Integer) As Pointf()
    '从点表数组ar()提取指定从点号fir到点号las的点表数组并返回
    Dim lp() As Pointf
    Dim i As Integer, m As Integer, t As Integer, s As Integer
   
    m = las - fir
    ReDim lp(m)
    For i = 0 To m
        lp(i) = ar(fir + i)
    Next i
    LpSam = lp
End Function

 

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

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

feye

DIS()函数

Private Function DIS(p1 As Pointf, p2 As Pointf) As Pointf
    '给定两点坐标,返回两点间的距离及P1至P2的方位角其方位角是以弧度表示
    Dim x As Double, y As Double, f As Double
    x = p2.x - p1.x: y = p2.y - p1.y
    DIS.x = Sqr(y * y + x * x)
    If x = 0 Then
        DIS.y = IIf(y > 0, Pi / 2, 3 * Pi / 2): Exit Function
    Else
        f = Atn(y / x)
    End If
    If x < 0 Then
        f = Pi + f
    Else
        If y < 0 Then f = 2 * Pi + f
    End If
    DIS.y = f
End Function

 

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

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

plxmm

谢谢：feye

可否就你的函数代码，给出Excel中实际的数据，做案例啊？

asdfgh1234

对CAD有兴趣,可以到明经通道,晓东ＣＡＤ，那边专门讨论ＣＡＤ的

来生缘

这CAD对机器的要求如何?