圆弧和直线连接

兰州人

 

 Function ConnectExcel(InputSheetName As String) As Object
   Dim xlApp As Object
   On Error Resume Next
   Set xlApp = GetObject(, "Excel.Application")
   Set ConnectExcel = xlApp.ActiveWorkbook.Sheets(InputSheetName)
End Function

Sub abab()
  Set ee = ConnectExcel("Sheet1")
  Dim lineObj As AcadLine, arcObj As AcadArc
  Dim pp(0 To 2) As Double, ppp(0 To 2) As Double, pppp(0 To 2) As Double
  Dim app(0 To 2) As Double
  With ee
    For ii = 2 To 9
      Select Case Trim(.Cells(ii, 1))
        Case "AcDbLine"
          Set lineObj = ThisDrawing.HandleToObject(.Cells(ii, 2))
          For jj = 0 To 2
            pp(jj) = .Cells(ii, jj + 4).Value
            ppp(jj) = .Cells(ii, jj + 7).Value
          Next jj
          lineObj.StartPoint = pp: lineObj.EndPoint = ppp
          lineObj.color = 1
        Case "AcDbArc"
          Set arcObj = ThisDrawing.HandleToObject(.Cells(ii, 2))
          arcObj.color = 1
          For jj = 0 To 2
            arcObj.StartPoint(jj) = .Cells(ii, jj + 4).Value
            arcObj.EndPoint(jj) = .Cells(ii, jj + 7).Value
            arcObj.Center(jj) = .Cells(ii, jj + 10).Value
            arcObj.StartAngle = .Cells(ii, jj + 11).Value
            arcObj.EndAngle = .Cells(ii, jj + 12).Value
            arcObj.Radius = .Cells(ii, jj + 13).Value
          Next jj
          arcObj.color = 3
      End Select
    Next ii
  End With
End Sub