当前位置: 代码迷 >> AutoCAD >> Excel表格到CAD的示例程序(来自明经CAD社区)解决思路
  详细解决方案

Excel表格到CAD的示例程序(来自明经CAD社区)解决思路

热度:1814   发布时间:2013-02-26 00:00:00.0
Excel表格到CAD的示例程序(来自明经CAD社区)
此贴内容原作者为“明经CAD社区”的“efan2000”。原贴链接如下:
http://bbs.mjtd.com/dispbbs.asp?boardid=16&Id=16244
本人觉得较为精典,故在此贴出,供更多网友参考。

Sub Test()
    On Error Resume Next 

    ' 连接Excel应用程序 
    Dim xlApp As Excel.Application
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        MsgBox " Excel 应用程序没有运行。请启动 Excel 并重新运行程序。"
        Exit Sub
    End If
    Dim xlSheet As Worksheet
    Set xlSheet = xlApp.ActiveSheet 
    ' 当初考虑将表格做成块的方式,可以根据需要取舍。
    'Dim iPt(0 To 2) As Double
    'iPt(0) = 0: iPt(1) = 0: iPt(2) = 0
    Dim BlockObj As AcadBlock
    Set BlockObj = ThisDrawing.Blocks("*Model_Space")
    Dim iPt As Variant
    iPt = ThisDrawing.Utility.GetPoint(, "指定表格的插入点: ")
    If IsEmpty(iPt) Then Exit Sub
    Dim xlRange As Range
    Debug.Print xlSheet.UsedRange.Address
    For Each xlRange In xlSheet.UsedRange
        AddLine BlockObj, iPt, xlRange
        AddText BlockObj, iPt, xlRange
    Next
    Set xlRange = Nothing
    Set xlSheet = Nothing
    Set xlApp = Nothing
End Sub

'边框线条粗细
Function LineWidth(ByVal xlBorder As Border) As Double
    Select Case xlBorder.Weight
        Case xlThin
            LineWidth = 0
        Case xlMedium
            LineWidth = 0.35
        Case xlThick
            LineWidth = 0.7
        Case Else
            LineWidth = 0
    End Select
End Function

'边框线条颜色,处理的颜色不全,请自己添加
Function LineColor(ByVal xlBorder As Border) As Integer
    Select Case xlBorder.ColorIndex
        Case xlAutomatic
            LineColor = acByLayer
        Case 3
            LineColor = acRed
        Case 4
            LineColor = acGreen
        Case 5
            LineColor = acBlue
  相关解决方案