pop3k

Dzięki za ekspresową odpowiedź. Tak, o to chodziło.

Witam od zwcada 2024 zmieniła się funkcja wydłuż / extend. Program nie prosi już domyślnie o krawędź do wydłużenia. Pamiętam, że jest jakaś zmienna, która przywraca działanie funkcji jak w poprzednich wersjach. Podpowiecie mi jaka?

Albo inaczej - czy obok własnych ikonek interfejsu można dodać ikonkę/kontrolkę typu textbox która będzie obsługiwana poprzez VBA?

Czy poprzez VBA można wpłynąć na zmianę obrazka w ikonce interfejsu? Nie chodzi mi o standardowe ikonki tylko o te dodane przeze mnie. Po kliknięciu w ikonkę chciałbym, żeby podmieniła się bitmapa a tym samym kolor tej oraz sąsiedniej ikonki. Jeżeli nie przez VBA to da się przez C#?

Macie może informacje czy w wersji 2024 zostało to poprawione?

Macie może informacje czy w wersji 2024 zostało to poprawione?

Cześć, zauważyłem kolejny błąd w ZWCAD, proszę o pomoc w możliwościach. Napisałem sobie taki prosty kod ze wstawieniem bloku. Blok posiada okrąg i atrybuty. Zauważyłem, że po kolejnym wstawieniu bloku lokalizacja względem obiektu - kwadrant koła - przestaje działać na bloku. Wszystko przedstawia poniższy filmik. Kod: Private Sub CommandButton1_Click() UserForm1.hide Dim BlockRef As ZcadBlockReference Dim BlockAttributes As Variant Dim PIERWSZY As Variant Dim FileToInsert As String PIERWSZY = ThisDrawing.Utility.GetPoint(, "Podaj punkt P1") FileToInsert = "C:\e-cad\e-cad Zelbet Stal Drewno\Bloki\Opisy\e-cad_ZelbetOpis_7.dwg" Set BlockRef = ThisDrawing.ModelSpace.InsertBlock(PIERWSZY, FileToInsert, 1, 1, 1, 0) BlockAttributes = BlockRef.GetAttributes BlockAttributes(0).TextString = "blok" BlockRef.Update Exit Sub End Sub (W kodzie dodałem na końcu Exit Sub, bo myślałem, że obiekt gdzieś wiruje w tle ale to nic nie dało. W filmiku tego Exit Sub nie było) Filmik: http://cloud.movavi.com/show/47b0ff05-a0a5-4862-8df1-0a48f3990d14

Działa. Czyli jest rozwiązanie tymczasowe. entity = "(handent " & Chr(34) & BlockRef.Handle & Chr(34) & ")" punkty = pt1(0) & "," & pt1(1) & " " & pt2(0) & "," & pt2(1) punkt1 = Replace(pt1(0), ",", ".") punkt2 = Replace(pt1(1), ",", ".") punkt3 = Replace(pt2(0), ",", ".") punkt4 = Replace(pt2(1), ",", ".") punkt = punkt1 & "," & punkt2 & " " & punkt3 & "," & punkt4 ThisDrawing.SendCommand "_MIRROR" & vbCr & entity & vbCr & vbCr & punkt & vbCr & "Tak" & vbCr ThisDrawing.SendCommand "STR_ZPP_v2" frm_ZP_v2.hide Zapisuję kod na forum dla tych co szukają gotowego rozwiązania. Dziekuję!

Drugie pytanie: czy funkcja vba object.mirror znajduje się w bibliotece ZWCAD 2021 Type Library? A może w innej? A może mogę podmienić biblioteki? Nie wiem, plik?

A mi przychodzi. Tylko nie wiem jak. Czy można wywołać funkcję lustra z poziomu vba? tak, żeby podczas wykonywania linii sam sobie napisał wywołanie funkcji, podał 2 punkty charakterystyczne dla lustra i kontynuował kod VBA?

Faktycznie lepiej będzie przedstawić to na obrazku. Skróciłem blok i zwymiarowałem jego punkty charakterystyczne. To, jak było w ZWCAD 2020 i jak jest w 2023. Widać, że w 2023 (drugi atrybut tekstowy) funkcja mirror dokładnie odbija wskazane punkty a nie tak jak funkcja lustro i w 2020 czyli jakby dopasowuje do wielkości tekstu i tam wstawia punkt charakterystyczny

Na filmiku - blok górny został przygotowany tak jak ma być finalnie. Niestety nie mam już dostępu do wersji 2020 bo miałem jakiś błąd prze który musiałem przeinstalować i wybrałem aktualizację (przy okazji) do wersji 2023. Na słowo - musicie mi uwierzyć, że blok był prawidłowo odbijany tak, jakby go zrobić lustrem w opcjach cadowskich.

Trochę tak, ale wtedy literki w bloku są w odbiciu lustrzanym 😕

Pracuję już długo na swoim makrze. Wszystko działało na Zwcad 2020 do czasu przejścia na Zwcad 2023 SP2. Doszedłem do tego, że object.Mirror nie działa prawidłowo na blokach. Niby odbija lustrzanie blok ale nie jego atrybuty. Wszystko nagrałem na poniższym filmiku. Macie jakieś porady jak to naprawić? '******** bigle ********* '------------------------ If typ = "bigle" Then BlockAttributes(0).TextString = ilosc & "%%c" & srednica & "-U-co" & d If typ = "bigle" And PIERWSZY(0) < DRUGI(0) And blizszyKierunek = "poziom" Then pt1(0) = TRZECI(0) pt1(1) = TRZECI(1) pt2(0) = pt1(0) pt2(1) = CZWARTY(1) MsgBox "pt1(" & pt1(0) & "," & pt1(1) & ")" & vbNewLine & "pt2(" & pt2(0) & "," & pt1(2) & ")" Set objDrawingObject = BlockRef.Mirror(pt1, pt2) MsgBox "Set objDrawingObject = BlockRef.Mirror(pt1, pt2)" objDrawingObject.Update MsgBox "objDrawingObject.Update" BlockRef.Delete End If http://cloud.movavi.com/show/ae358aa9-062f-42d0-a41c-308042aa56db

Będę ogarniał użycie tych komórek, ale podpowiedz co najlepiej z nimi robić? Zapisywać w tablicy i w niej szukać, w kolekcji i w niej szukać, czy bezpośrednio z excela za każdym razem pętlić? A może inny sposób?

Musimy włączyć bibliotekę Microsoft Excel z poziomu References w VBA for Applications oraz odpalony program Excel Sub import_SAF() MsgBox "importuję SAF" Dim excelApp As Excel.Application Dim wb As Excel.Workbook Dim folder, Name, FileName As String Dim ExcelWasNotRunning As Boolean Set excelApp = Nothing Set wb = Nothing FileName = FileBrowseOpen("c:", "Otwórz plik SAF", "Pliki SAF (*.xlsx)", 1) '' Make sure Excel application is running On Error Resume Next Set excelApp = GetObject(, "Excel.Application") If Err.Number <> 0 Then ExcelWasNotRunning = True Err.Clear ' Clear Err object in case error occurred. If ExcelWasNotRunning Then Set excelApp = CreateObject("Excel.Application") If excelApp Is Nothing Then MsgBox "Cannot start Excel Application!" Exit Sub Else excelApp.Application.Visible = True End If End If excelApp.Application.Visible = True '' Make sure the Workbook is open On Error GoTo 0 Dim w As Excel.Workbook For Each w In excelApp.Workbooks If UCase(w.FullName) = UCase(FileName) Then Set wb = w Exit Sub End If Next On Error Resume Next If wb Is Nothing Then Set wb = excelApp.Workbooks.Open(FileName, , False) End If If wb Is Nothing Then MsgBox "Cannot open file: " & vbCrLf & FileName Else wb.Activate End If End Sub Można będzie jeszcze pobawić się automatycznemu wymuszeniem otwarcia programu Excel oraz Application.Visible = False ale to nie jest teraz jakieś bardzo istotne. Wczytujemy, teraz jak się dobrać do środka tego excela i wyświetlić dane z arkusza

OK, mamy szukanie pliku (coś nie działa filtr przy wybieraniu i nie wiem co to za "nFilterIndex" no ale jest. Usunąłem zbędną część. Option Explicit '---------------------------------------------------------------------- ' 64 bit VBA 7 version of File and Folder Browswers ' FileBrowseOpen() ' FileBrowseSave() ' FolderBrowse() ' Much of the original 32 bit module was donated by the good people of XtremeVbTalk.com ' I massaged it to be 64 bit with VBA 7 code lifted from numerous sites on the web '---------------------------------------------------------------------- Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long '(...) Private Type OPENFILENAME lStructSize As Long hWndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As LongPtr lpTemplateName As String End Type '(...) Public Function FileBrowseOpen(ByVal sInitFolder As String, _ ByVal sTitle As String, _ ByVal sFilter As String, _ ByVal nFilterIndex As Integer) As String Dim OpenFile As OPENFILENAME Dim lReturn As Long sInitFolder = CorrectPath(sInitFolder) OpenFile.lpstrInitialDir = sInitFolder ' Swap filter separator for api separator sFilter = Replace(sFilter, "|", Chr(0)) OpenFile.lpstrFilter = sFilter OpenFile.nFilterIndex = nFilterIndex OpenFile.lpstrTitle = sTitle OpenFile.hWndOwner = 0 OpenFile.lpstrFile = String(257, 0) OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1 OpenFile.lStructSize = LenB(OpenFile) OpenFile.lpstrFileTitle = OpenFile.lpstrFile OpenFile.nMaxFileTitle = OpenFile.nMaxFile OpenFile.flags = 0 lReturn = GetOpenFileName(OpenFile) If lReturn = 0 Then FileBrowseOpen = "" Else FileBrowseOpen = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1)) End If End Function '(...) Private Function CorrectPath(ByVal sPath As String) As String If Right$(sPath, 1) = "\" Then If Len(sPath) > 3 Then sPath = Left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root Else If Len(sPath) = 2 Then sPath = sPath & "\" ' Append backslash to root End If CorrectPath = sPath End Function '(...) Sub import_SAF() MsgBox "importuję SAF" Call FileBrowseOpen("c:", "Otwórz plik SAF", "Pliki SAF (*.xlsx)", 1) End Sub

Witam, chciałbym stworzyć procedurę w zwcadzie, która po uruchomieniu: 1. otworzy okienko windowsowe "Otwórz plik" z przefiltrowaniem tylko .*xlsx 2. Po wybraniu pliku prześledzi odpowiednie kolumny odpowiedzialne za koordynaty x, y, z w odpowiednim arkuszu excelowym i zacznie je zapisywać do jakiejś tablicy, bądź od razu weźmie się za wstawianie punktów w modelu. O co chodzi? Otóż mam tak zwany plik SAF (Strucural Analytical Format) (w załączniku przykładowy) - wygenerowany z programy Archicad - jest to plik z rozszerzeniem xlsx zawierający m.in. - koordynaty węzłów -> w arkuszu "StructuralPointConnection" - geometrię belek i słupów (linia łącząca 2 węzły) -> w arkuszu "StructuralCurveMember" - geometrię ścian, płyt, powłok (obszar złożony z 4 węzłów) -> w arkuszu "StructuralSurfaceMember" Poza tym zawiera więcej ciekawych informacji - jak materiał, przekrój ale w moim projekcie nieistotne. Otóż docelowo chciałbym aby ZWCAD narysował w przestrzeni wszystkie występujące belki, słupy (jako linie) oraz ściany płyty i powłoki jako powierzchnie 3d. Pomożecie? 1112.xlsx

Super robota! Dziękuję

Super!

Ten addselected jakby jeszcze pobierał skalę, szerokość i rodzaj linii to byłoby super

Dziękuję bardzo za pomoc, spróbuję poskładać wszystko do kupy i stworzyć mój superblok. Co do zliczania pozycji to już mam takie makro (ewentualnie korzystam z już dostępnych)

Co do 3. Może nie edytujmy bloku, bo zaraz wszystkie bloki o tej nazwie będą miały zmieniony kolor a mi zależy tylko na jednym. Może da się zatem zmienić tylko kolor jego atrybutów?

Tak też o tym myślałem. Tak będę kombinował Do stworzenia superbloku potrzebne mi jeszcze kilka patentów. 1. Jaka komenda vba poda mi współrzędne zaznaczonego bloku? 2. Czy istnieje możliwość podania współrzędnych w jakiejś funkcji a funkcja zwróci nazwy wszystkich bloków występujących w tym punkcie i je zaznaczy? 3. Czy jest możliwość zaingerowania w blok nie edytując go. Na przykład po spełnieniu określonego warunku wszystko co jest wewnątrz bloku zmieni kolor na żółty.

Tak jak pisałem, chcę odczytać tę wartość i zapisać ją w atrybucie bloku (odczytywać to, co jest w czerwonej ramce i zapisywać w niebieskiej - patrz 9 post) za każdym razem, gdy blok zostanie zmieniony.