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
oExcelAs
Excel.ApplicationOn Error Resume Next
Set
oExcel = GetObject(, "Excel.Application")If
Err <> 0Then
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
oSheetAs
Excel.WorksheetSet
oSheet = oExcel.ActiveSheetIf
Err <> 0Then
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 = 75Dim
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 = 0To
(endRow - startRow)Dim
oRangeAs
RangeSet
oRange = oSheet.Cells(i + startRow, columnX) arrPoints(i * 2) = oRange.ValueSet
oRange = oSheet.Cells(i + startRow, columnY) arrPoints(i * 2 + 1) = oRange.ValueNext
iDim
oPolylineAs
AcadLWPolylineSet
oPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(arrPoints)If
Err <> 0Then
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
oExcelAs
Excel.ApplicationOn Error Resume Next
Set
oExcel = GetObject(, "Excel.Application")If
Err <> 0Then
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
oSheetAs
Excel.WorksheetSet
oSheet = oExcel.ActiveSheetIf
Err <> 0Then
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 = 2Dim
arrPoints()As Double
ReDim
arrPoints((endRow - startRow) * 2 + 1)For
i = 0To
(endRow - startRow)Dim
oRangeAs
RangeSet
oRange = oSheet.Cells(i + startRow, columnX) arrPoints(i * 2) = oRange.ValueSet
oRange = oSheet.Cells(i + startRow, columnY) arrPoints(i * 2 + 1) = oRange.ValueNext
iDim
oPolylineAs
AcadLWPolylineSet
oPolyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(arrPoints)If
Err <> 0Then
MsgBox
"Došlo k chybě při vytváření křivky."
Exit Sub
End If
End Sub
Copyright © 2001 CAD Studio s.r.o.