Forum użytkowników programów ZWCAD, KOMPAS-3D, Scan2CAD, PDF2CAD

[Michał J]

Witam
pytnie jak w temacie,
mam ZwCada 2009i pro, 2009.07.30(11052)
przerabiam makro z AutoCada które wygląda tak:

Sub Styl_WYM()

Dim StylWym As AcadDimStyle
Dim WYMIAR As AcadDimAligned
Dim P1(0 To 2) As Double
Dim P2(0 To 2) As Double
Dim Ptext(0 To 2) As Double
Dim SKALA_RYS As Integer
Dim WARSTWA As AcadLayer

SKALA_RYS = 50 ' przykładowo

Set WARSTWA = ThisDrawing.Layers.Add("Mic_WYMIARY")
WARSTWA.color = 8

ThisDrawing.ActiveLayer = WARSTWA

P1(0) = 0: P1(1) = 0: P1(2) = 0
P2(0) = 200: P2(1) = 0: P2(2) = 0
Ptext(0) = 100: Ptext(1) = 100: Ptext(2) = 0

Set WYMIAR = ThisDrawing.ModelSpace.AddDimAligned(P1, P2, Ptext) ' wstawiam wymiar

'edytuje wstawiony wymiar
WYMIAR.ScaleFactor = SKALA_RYS
WYMIAR.Arrowhead1Type = acArrowOblique
WYMIAR.Arrowhead2Type = acArrowOblique
WYMIAR.ArrowheadSize = 2.5
WYMIAR.TextStyle = "Mic_ROMANS_WYM"
WYMIAR.TextHeight = 3
WYMIAR.TextColor = acCyan
WYMIAR.DimensionLineExtend = 1.25
WYMIAR.DimensionLineColor = "8"
WYMIAR.ExtensionLineExtend = 3
WYMIAR.ExtensionLineColor = "8"
WYMIAR.ExtensionLineOffset = 10
WYMIAR.RoundDistance = 1
WYMIAR.TextMovement = acDimLineWithText

Dim NAZWA As String
NAZWA = "Mic_" & SKALA_RYS


Set StylWym = ThisDrawing.DimStyles.Add(NAZWA) ' tworze nowy styl wymiarowy
StylWym.CopyFrom WYMIAR ' kopiuje do stylu ustawienia z wstawionego wymiaru

ThisDrawing.ActiveDimStyle = StylWym ' ustawiam nowy styl wymiarowania na aktywny

WYMIAR.Delete 'kasuje juz niepotrzebny wymiar

End Sub


przeróbka do ZwCad'a:


Sub Styl_WYM()


Dim StylWym As ZwcadDimStyle
Dim WYMIAR As ZwcadDimAligned
Dim SKALA_RYS As Integer
Dim WARSTWA As ZwcadLayer


SKALA_RYS = 50 ' przykładowo

Set WARSTWA = ThisDocument.Layers.Add("Mic_WYMIARY")
WARSTWA.Color = 8

ThisDocument.ActiveLayer = WARSTWA

Dim X1, X2, X3, Y1, Y2, Y3 As Double 'inna deklaracja punktów wstawienia niż w ACad
Dim P1 As New ZwcadPoint
Dim P2 As New ZwcadPoint
Dim P3 As New ZwcadPoint

X1 = 0: Y1 = 0
X2 = 200: Y2 = 0
X3 = 100: Y3 = 100

P1.x = X1
P1.y = Y1

P2.x = X2
P2.y = Y2

P3.x = X3
P3.y = Y3

Set WYMIAR = ThisDocument.ModelSpace.AddDimAligned(P1, P2, P3)

'edytuje wstawiony wymiar
WYMIAR.ScaleFactor = SKALA_RYS
WYMIAR.Arrowhead1Type = zcArrowOblique
WYMIAR.Arrowhead2Type = zcArrowOblique
WYMIAR.ArrowheadSize = 2.5
WYMIAR.TextStyle = "Mic_ROMANS_WYM"
WYMIAR.TextHeight = 3
WYMIAR.TextColor = zcCyan
WYMIAR.DimensionLineExtend = 1.25
WYMIAR.DimensionLineColor = "8"
WYMIAR.ExtensionLineExtend = 3
WYMIAR.ExtensionLineColor = "8"
WYMIAR.ExtensionLineOffset = 10
WYMIAR.RoundDistance = 1
WYMIAR.TextMovement = zcDimLineWithText

Dim NAZWA As String
NAZWA = "Mic_" & SKALA_RYS

Set StylWym = ThisDocument.DimensionStyles.Add(NAZWA) ' w tej lini
StylWym.CopyFrom WYMIAR ' albo w tej makro sie wykrzacza

ThisDocument.ActiveDimStyle = StylWym

WYMIAR.Delete

End Sub


problem jest w tym że w ZwCad'zie klasa ZwCadDimStyle nie posiada CopyFrom jak to jest w AutoCadzie, pytanie jak ten problem obejść ?? czy ktoś już się z tym zetknął ??
problem jest też z grotami - niezmienia mi ich na "/" tylko są domyślne strzałki i pozostałych danych też nieprzypisuje jak inaczej można programowo edytować wymiar??

[kruszynski]

Rzeczywiście nie ma funkcji CopyFrom.
Dlaczego wybrał Pan taką metodę - Tworzenie obiektu wymiarowania i kopiowanie jego ustawień do stylu? Moim zdaniem lepiej byłoby poprostu utworzyć nowy styl i poustawiać jego właściwości.
W katalogu ZWCAD/Help jest plik: VBARef.chm, Jest w nim opisany model obiektowy i wszystkie dostępne właściwości i funkcje dla poszczególnych typów obiektów, style wymiarowania też są opisane.
Raczej nie znam łatwego rozwiązania problemu wyświetlania innych strzałek niż są we właściwościach, skonsultuję tą sprawę z producentem programu.
Inaczej programowo można edytować wymiary przez LISP. Jest to skomplikowane ale możliwe.

[Michał J]

Witam
i już po problemie
tworząc nowy styl wymiarowania pobiera on ustawienia ze zmiennych systemowych, więc najpierw nadaje odpowiednim zmiennym odpowiednie wartości a potem dodaje styl.

Przykładowy kod poniżej:

Sub Nowy_StylWYM()

Dim newStyle1 As ZwcadDimStyle

ThisDocument.SetVariable "DIMSCALE", 1
ThisDocument.SetVariable "DIMBLK", "."
ThisDocument.SetVariable "DIMASZ", 2.5
ThisDocument.SetVariable "DIMTXSTY", "Standard" '
ThisDocument.SetVariable "DIMTXT", 3
ThisDocument.SetVariable "DIMCLRT", 4
ThisDocument.SetVariable "DIMTAD", 0
ThisDocument.SetVariable "DIMTVP", 2.5 / 3
ThisDocument.SetVariable "DIMCLRE", 8
ThisDocument.SetVariable "DIMDLE", 0 '1.25
ThisDocument.SetVariable "DIMCLRD", 8
ThisDocument.SetVariable "DIMEXE", 2
ThisDocument.SetVariable "DIMJUST", 0
ThisDocument.SetVariable "DIMEXO", 10
ThisDocument.SetVariable "DIMRND", 1
ThisDocument.SetVariable "DIMDEC", 0
ThisDocument.SetVariable "DIMADEC", 1
ThisDocument.SetVariable "DIMTMOVE", 0
ThisDocument.SetVariable "DIMDLI", 5
ThisDocument.SetVariable "DIMATFIT", 0

Set newStyle1 = ThisDocument.DimensionStyles.Add("STYL_1")
ThisDocument.ActiveDimStyle = newStyle1

End Sub

W przeciwieństwie do tworzenia stylów tekstów to powyższy kod działa tylko przy pierwszym użyciu, przy drugiej próbie wyskakuje gdyż już taki styl ma dodany. Moje pytanie w związku z tym, czy ktoś wie jak sprawdzić czy dany styl już istnieje
- jeżeli niema to dodaje a jeżeli istnieje to nie dodaje. Proszę o jakiś przykład.
Z góry dziękuje

[kruszynski]

ja to robie tak:

Kod:

On Error Resume Next Set Blode = ThisDocument.Blocks.Item(newName) On Error GoTo 0 If TypeName(Blode) <> "Nothing"     ' chyba może też być warunek Blode Not(IsNothing)     ' tu sie dzieje co ma sie dziać EndIf

[Michał J]

Witam

Dziękuje za podpowiedz, po drobnej modyfikacji działa jak trzeba i wygląda to tak:

Kod:

... ... ... On Error Resume Next Set Blode = ThisDocument.Blocks.Item("STYL_1") If TypeName(Blode) = "Nothing" Then     Set newStyle1 = ThisDocument.DimensionStyles.Add("STYL_1")     ThisDocument.ActiveDimStyle = newStyle1 End If End Sub

W między czasie zrobiłem to tak : (wydaje mi się że prościej)

Kod:

Sub Nowy_StylWYM() Dim newStyle1 As ZwcadDimStyle On Error GoTo KONIEC    ' deklaracja zmiennych systemowych    ' dodanie stylu    ' aktywacja dodanego stylu KONIEC: End Sub

Tylko niewiem czy jak bardziej rozbuduje ten kod to może się okazać że ten sposób jest niewystarczający, ale pożyjemy zobaczymy
Jeszcze raz dziękuje za podpowiedź
Pozdrawiam

[kruszynski]

Niby dobrze, ale niedobrze
Blocks dałem jako przykład bo taki miałem pod ręką, powinno być Textstyles czy jakoś podobnie.
To co Pan napisał będzie działało ale jak na końcu nie będzie
On Error GoTo 0
to poza funkcją jeśli wystąpi jakiś inny dowolny błąd to wróci znów do etykiety KONIEC co skutecznie zapętli program. Powodzenia w późniejszym diagnozowaniu gdzie jest błąd.

[kruszynski]

Można też zrobić tak:

Kod:

. . On Error GoTo DefiniujStyl 'teraz styl jest, albo nie Set Blode = ThisDocument.Textstyles.Item("STYL_1") 'jak nie ma, to przechodzi do etykiety 'Tu moge używać stylu bo napewno jest Exit Sub ' jak tego nie będzie to zawsze wykona sie to co jest po etykiecie. DefiniujStyl: 'Tu tworze i definiuje właściwości stylu Resume Next ' to przenosi spowrotem do Set Blode.... End Sub

Czasem też można użyć takich sposobów, ale przy większej ilości kodu łatwo sie w tym pogubić.