Dělení vybraných objektů v měřítku

Produkt: AutoCAD 2006
Datum: 15.07.2005

Ukázková funkce fixDIVIDE ilustruje použití výběrové množiny AutoCADu ve VBA, použití příkazů bez ActiveX rozhraní (např. Divide, Measure, Explode) a kombinace VBA+LISP. Funkce se dotáže na výběrovou množinu (musí být ve výkresu jedinečná, takže při každém použití původní množinu maže) a poté pro všechny objekty vybrané uživatelem volá příkaz DĚLÚ (_DIVIDE). Protože tento příkaz nemá objektové rozhraní, je vyvoláván funkcí SendCommand. Příkaz očekává zadání objektu jako entity, tedy včetně bodu ukázání. To lze ve VBA nasimulovat předáním entity převedené např. z Handle objektu. K tomu je zde použita LISP funkce (handent).

Funkci lze použít pro rozdělení vybraných objektů na pevný (popř. zadaný) počet úseků (popř. ji upravit na délku úseku náhradou volané funkce na _MEASURE), volitelně s vložením bloku.

Pro přenesení VBA kódu funkce si pomocí Alt-F11 spusťte editor VBA a zkopírujte si tento jednoduchý kód (nebo si otevřete přiložený projekt .DVB):


Sub fixDIVIDE()

Dim selectionSet As AcadSelectionSet
Dim entity As AcadEntity
Dim eHandle As String
Dim str1 As String
Dim cmdstr As String

'To see the divided POINTs
ThisDrawing.SetVariable "PDMODE", 2

'Delete the selection set if already exists
For Each selectionSet In ThisDrawing.SelectionSets
 If selectionSet.Name = "forDIVIDE" Then
  selectionSet.Delete
  Exit For
 End If
Next selectionSet

Set selectionSet = ThisDrawing.SelectionSets.Add("forDIVIDE")
selectionSet.SelectOnScreen

For Each entity In selectionSet
 eHandle = entity.Handle
 str1 = "(handent """ + eHandle + """" + ")"
 cmdstr = "_DIVIDE "
' if you want to DIVIDE using Block "myblock" use this version of cmdstr
' cmdstr = cmdstr & str1 & vbCr & "_blo" & vbCr & "myblock" & vbCr & "_Yes" & vbCr & "10" & vbCr
 cmdstr = cmdstr & str1 & vbCr & "10" & vbCr
 ThisDrawing.SendCommand (cmdstr)
Next
 
MsgBox ("Selected objects were DIVIDEd.")

End Sub

Nyní již jen musíme vyvolat nově vytvořenou funkci. Ve spuštěném AutoCADu stiskněte Alt-F8 a v seznamu maker zvolte fixDIVIDE. Pro automatické spuštění lze využít např. příkaz APLČTI (_APPLOAD) a příkaz -VBARUN.