zde je utilitka do Autocadu které u všech nastaví globalwidth=0
Sub zerothick()
'všem polyline ve výkrese nastaví globalwidth = 0
'deklarace
Dim intGroupCode(0) As Integer
Dim varDataCode(0) As Variant
Dim objAcadPoly As AcadLWPolyline 'deklarace jako objekt
' mazání starých selection setů
On Error Resume Next
intGroupCode(0) = 0
varDataCode(0) = "LWPolyline"
ThisDrawing.SelectionSets.Item("Poly").Delete
If Err Then Err.Clear
'select all
Set objSelectionSet = ThisDrawing.SelectionSets.Add("Poly")
objSelectionSet.Select acSelectionSetAll, , , intGroupCode, varDataCode
'cyklus prochází všechny poly v selekci, a nastaví Globalwidth = 0
For Each objAcadPoly In objSelectionSet
objAcadPoly.ConstantWidth = 0
Next objAcadPoly
End Sub
Žádné komentáře:
Okomentovat