Dobrý den, zcela nedávno jsem přešel na Civil 3D a narazil jsem na problém s importem bodů výškopisu pro vytvoření DMT. Většinou dostávám soubor s půdorysem a samostatný výškopisný soubor, ve kterém jsou pouze texty v souřadnicích a výška je jako textová hodnota.
Pokud chci vytvořit DMT, tak musím data textů vyexportovat přípradně provést report z Mapu, upravit v excelu, uložit a znovu načíst tabulku bodů a z nich pak vytvořit DMT. Zdá se mi to celkem zdržující a komplikované. Takže pro zájemce je tady kostra jednoduchého VBA makra, které převede (a případně rovnou vymaže) dané texty na 3D body ACADu, ze kterých lze konverzí přímo udělat body Civilu. Nevýhodou je, že body nemají vlastní čísla (Civil je očísluje sám). Doufám, že to někomu přijde vhod i jako příklad VBA. Šťastné a veselé všem uživatelům CAD Fóra.
 
'pomocné makro pro převod výšek, které jsou jako textové hodnoty do 3D bodů ACADu'Chop 19.12.2006
'před spuštěním byste měli mít vybrány objekty ke zpracování (texty)'pomocné ACADbody se vytvoří do aktivní hladiny'pomocné ACADbody nejsou očíslovány
'po proběhnutí makra již ručně stačí použít příkaz Civilu z nabídky'CreatePoints "Convert ACAD Points"'očíslování bodů si udělá CIVIL 3D sám'pomocné body ACAD Points jsou opravdu konvertovány na body Civilu a nemusíte je mazat'a nezapoměňe si předem vypnout dotaz na Description (Prompt for Descriptions: None)'pak lze DMT vytvořit jediným příkazem z bodů
Dim obj As AcadObject 'pomocná proměnná pro obecný objekt ACADuFor Each obj In ThisDrawing.ActiveSelectionSet 'projdeme všechny vybrané objekty (musí být vybrány před spuštěním tohoto makra)    If TypeOf obj Is AcadText Then 'pracujeme pouze s texty        Dim txt As AcadText 'vytvoříme pomocný objekt konkrétního typu        Set txt = obj 'a tady z obecného objektu vytvoříme konkrétní, protože jinak se nedostaneme k podrobným vlastnostem jako je obsah textu        If Len(txt.TextString) > 0 Then 'pokud obsah textu není prázdný pokračujeme ve zpracování           Dim bod(0 To 2) As Double 'pomocné pole pro vytvoření 3D bodu           bod(0) = txt.InsertionPoint(0) 'převzetí x-ové souřadnice nového bodu z x-ové souřadnice textu           bod(1) = txt.InsertionPoint(1) 'převzetí y-ové souřadnice nového bodu z y-ové souřadnice textu           bod(2) = Val(txt.TextString) 'převzetí z-ové souřadnice bodu z textové hodnoty - není ošetřeno na nesmyslné textové hodnoty! CDbl kupodivu hlásí chybu (nezvládne ")           ThisDrawing.ModelSpace.AddPoint bod 'vytvoření nového bodu v modelu           'txt.Delete 'pokud chcete použitý text z výkresu vymazat, odstraňte první '        End If 'konec zpracování neprázdného textu     End If 'konec zpracování jednoho textuNext obj 'pokračujeme ve zpracování dalšího objektuEnd Sub