Jak načíst souřadnice bodu v Excelu do AutoCADu?

Produkt: AutoCAD 2002
Datum: 07.12.2001

Častou otázkou uživatelů je, jak lze do AutoCADu načíst hodnoty souřadnic bodů. V tomto příkladu si ukážeme, jak pro řešení tohoto problému můžeme použít VBA.
V tabulce v MS Excelu máme ve sloupci hodnoty X a Y (pro testovací účely použijeme hodnoty funkcí SIN a COS).

Pro to, abychom mohli v našem VBA programu pracovat s knihovnou objektů programu MS Excel, musíme nejprve provést připojení knihovny EXCEL9.OLB. K tomu použijeme volbu References v nabídce Tools:

V dialogu References vyhledáme knihovnu Microsoft Excel 9.0 Object Library.

Nyní můžeme v našem VBA kódu používat i objekty knihovny Excel a ukážeme si, jak se "napojíme" na spuštěnou instanci MS Excel:

    Dim oExcel As Excel.Application
        
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")
    If Err <> 0 Then
	MsgBox "Došlo k chybě při získávání objektu Excel. Zkontrolujte, zda je spuštěna aplikace."
        Exit Sub
    End If

K ošetření chyb jsme opět použili výraz On Error Resume Next a tam, kde očekáváme výskyt chyby, testujeme proměnnou Err. V našem případě by se např. mohlo sát, že Excel nebude spuštěný a hodnota proměnné oExcel by tedy byla prázdná (Nothing).
Podobně se pokusíme získat i objekt oSheet, který představuje aktivní sešit (proměnná typu Worksheet).

    Dim oSheet As Excel.Worksheet
    Set oSheet = oExcel.ActiveSheet
    If Err <> 0 Then
      	MsgBox "Došlo k chybě při získávání aktivní sešitu. Zkontrolujte, zda je otevřen sešit v MS Excel."
      	Exit Sub
    End If

Souřadnice vykreslíme jako křivku, kterou je VBA repreznetována objektem AcadLWPolyline. Při vytváření křivky musíme zadat pole čísel, které reprezentuje hodnoty souřadnic X a Y. Velikost pole vypočteme tak, že od sebe odečteme koncový a počáteční řádek. Výsledek vynásobíme dvěma (dvě souřadnice - X a Y) a přičteme jedničku (pole je indexováno od nuly).

    startRow = 3
    endRow = 75
    
    Dim arrPoints() As Double
    ReDim arrPoints((endRow - startRow) * 2 + 1)

Ve smyčce budeme procházet buňky, číst jejich hodnoty a hodnotami plnit pole souřadnic. Křivku nakonec vykreslíme pomocí metody AddLightWeightPolyline.

    For i = 0 To (endRow - startRow)
      Dim oRange As Range
      Set oRange = oSheet.Cells(i + startRow, columnX)
      arrPoints(i * 2) = oRange.Value
      Set oRange = oSheet.Cells(i + startRow, columnY)
      arrPoints(i * 2 + 1) = oRange.Value
    Next i
    Dim oPolyline As AcadLWPolyline
    Set oPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(arrPoints)
    If Err <> 0 Then
	MsgBox "Došlo k chybě při vytváření křivky."
        Exit Sub
    End If

Výsledný kód funkce by vypadal následovně:

Sub graph()
    Dim oExcel As Excel.Application
        
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")
    If Err <> 0 Then
	MsgBox "Došlo k chybě při získávání objektu Excel. Zkontrolujte, zda je spuštěna aplikace."
        Exit Sub
    End If
    
    Dim oSheet As Excel.Worksheet
    Set oSheet = oExcel.ActiveSheet
    If Err <> 0 Then
      	MsgBox "Došlo k chybě při získávání aktivní sešitu. Zkontrolujte, zda je otevřen sešit v MS Excel."
      	Exit Sub
    End If
    
    startRow = 3
    endRow = 75
    columnX = 1
    columnY = 2
    
    Dim arrPoints() As Double
    ReDim arrPoints((endRow - startRow) * 2 + 1)
    For i = 0 To (endRow - startRow)
      Dim oRange As Range
      Set oRange = oSheet.Cells(i + startRow, columnX)
      arrPoints(i * 2) = oRange.Value
      Set oRange = oSheet.Cells(i + startRow, columnY)
      arrPoints(i * 2 + 1) = oRange.Value
    Next i
    Dim oPolyline As AcadLWPolyline
    Set oPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(arrPoints)
    If Err <> 0 Then
	MsgBox "Došlo k chybě při vytváření křivky."
        Exit Sub
    End If
End Sub