Michał J

aa jeszcze załącznik :)

Witam Procedura jest częścią większej nakładki która będzie wykorzystywać dane zapamiętane w rysunku w zmiennych useri1-5 i userr1-5. Przydatne to będzie w sytuacji gdy z rysunku będą korzystać inne osoby i będą mogły przejąć ustawienia z rysunku (np. skala, jednostka rysowania, jednostka wymiarowania). Procedura jest wywoływana za pomocą kodu "Disel" wpisanego do przycisku na pasku narzędziowym: ^C^C-vbarun A_USTAWIENIA.Skala_Rysunku Zmienna useri1 nie jest nigdzie wcześniej używana i żadna procedura nie zapisuje do niej danych, są to początkowe ustawienia przed dalszym używaniem nakładki, domyślnie w pliku ustawiona jest na 0 i odpalając rysunek przez plik makro powinno zwrócić wartość 0, a jeżeli były wcześniej wprowadzone dane to też powinno je zwrócić. Zwraca zapamiętaną wartość dopiero jak plik otworze odpalając Zwcada i potem Plik\Otwórz... Zmienna useri1-5 jest typu integer czyli liczby całkowite i innych danych niemożna do niej wprowadzić. Jak odpale rysunek przez Zwcada (makro działa) i odpale następny rysunek ale przez klik na pliku to też działa, więc wydaje mi się że to ma związek ze zmiennymi systemowymi. Może jest jakaś zmienna systemowa (o której ja niewiem) która rozpoznaje w jaki sposób została otwarta sesja ZwCada ?? i ta zmienna miesza. Stosując zaproponowany kod On Error Resume Next OBECNA = Thisdocument.GetVariable("useri1") On Error GoTO 0 to przeskakuje dalej ale wykrzacza się wtedy na następnej linii kodu i daje komunikat -> patrz. załącznik Funkcji Err nie mam jeszcze opanowanej :( - proszę o jakieś rozwiązanie z jej wykorzystaniem które rozwiąże mój problem. Jeżeli nie będzie można z tym nic zrobić to będę musiał dać uwagę do nakładki że pliki należy odpalać przez Plik\Otwórz a chciałbym uniknąć tej niedogodności. pozdrawiam Michał J

a zapomniałem napisać pracuje na ZWCAD 2009i (2007.07.30)

Witam Problem polega na tym że funkcja działa prawidłowo tylko wtedy gdy rysunek otworze przez uruchomionego ZwCada, natomiast gdy otwieram przez plik z z rysunkiem i otwiera się Zwcad to ta funkcja niedziała i muszę ręcznie przeładować makro żeby to zatrybiło. Pytanie czy to tak już poprostu jest , czy da się to jakoś obejść bo np. brakuje mi czegoś w kodzie (poniżej) Sub Skala_Rysunku() Dim SKALA As Double Dim OBECNA As Integer Dim NOWA As String OBECNA = Thisdocument.GetVariable("useri1") ' w tym miejscu wywala kod jeżeli rysunek był uruchamiany z pliku Thisdocument.Utility.prompt vbCrLf & "Aktualna skala: " & "<" & "1:" & OBECNA & ">" START: Thisdocument.Utility.InitializeUserInput 1, "" SKALA = Thisdocument.Utility.GetInteger(vbCrLf & "PODAJ SKALĘ: ") If Not SKALA > 0 Then Thisdocument.Utility.prompt vbCr & "!!!! Skala musi być >0 !!!!" GoTo START Else NOWA = "useri1" Thisdocument.SetVariable NOWA, SKALA OBECNA = Thisdocument.GetVariable("useri1") Thisdocument.Utility.prompt vbCrLf & "Zmieniono skalę na: " & "<" & "1:" & OBECNA & ">" End If End Sub pozdrawiam M.J

Witam Dziękuje za podpowiedz, po drobnej modyfikacji działa jak trzeba i wygląda to tak: ... ... ... 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) :smile: 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 :smile: Jeszcze raz dziękuje za podpowiedź Pozdrawiam

Witam i już po problemie :) :grin: 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

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??

Czy już coś wiadomo ?? Tak na marginesie to w głównym nagłówku okna ZwCada 2008i jest literówka: ...Profesjonalana chłopaki musieli sie baaardzo spieszyć z tłumaczeniem :D

Witam Ok, to czekam na wieści w tej sprawie, będe się przypominał czcionki te wykorzystuje tylko w plikach stworzonych wcześniej w tamtym programie żeby je poprawnie odczytać,

Witam Jeszcze dodam że te wymienione czcionki ustawiam w jakimś stylu jako BigFont i wtedy moge dla danego stylu używać kodów do symboli, ale niestety w nowej polskiej wersji program tego "nie łyka" pozdr.

Witam zainstalowałem wersję 2008i PRO PL i mam pierwszą uwagę do niej Pierwsze co mi się rzuciło w oczy to że niedziałają czcionki z symbolami z programu *****, w wersji ANG. to działa. Kombinowałem z 1h żeby to działało i nic. Mam napisane dosyć rozbudowane nakładki które wykorzystują te czcionki, czy da sie cos z tym zrobić ?? Czcionki te to: ****.shx i ****.shx (jakby co to moge je podeslac do przetestowania) czcionki działają w ten sposób że wpisuje pionową kreskę i jakąś literę np: |c i otrzymuje [ (mniej więcej) lub też |C i otrzymuje ] i tym podobne proszę o jak najszybszą odpowiedz pozdr