pop3k

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.

No dobra, pomożecie powalczyć z reaktorem? Plik z blokiem dynamicznym - bohaterem w załączniku Procedura: Private Sub ZcadDocument_ObjectModified(ByVal Object As Object) Dim att As ZcadAttributeReference Dim atts As Variant If TypeOf Object Is ZcadBlockReference Then Set blk = Object If blk.EffectiveName = "Konstruktor_dozbrojenia" Then atts = blk.GetAttributes For j = 0 To UBound(atts) Set att = atts(j) If j = 0 Then MsgBox "Udało się" & att.TextString Next End If End If End Sub OK, trochę dziwnie wygląda odniesienie się do atrybutu tego bloku, ale działa.. Procedura powoduje wywalenie msgboxa z pokazaniem atrybutu po każdorazowej zmianie bloku. Zmieniona procedura: Private Sub ZcadDocument_ObjectModified(ByVal Object As Object) Dim att As ZcadAttributeReference Dim atts As Variant If TypeOf Object Is ZcadBlockReference Then Set blk = Object If blk.EffectiveName = "Konstruktor_dozbrojenia" Then atts = blk.GetAttributes For j = 0 To UBound(atts) Set att = atts(j) 'If i = 0 Then MsgBox "Udało się" & att.TextString Dim ss As ZcadSelectionSet Dim ent As ZcadEntity Dim bname As String Dim props() As ZcadDynamicBlockReferenceProperty Dim pvalue As Variant Dim blkref As ZcadBlockReference With ThisDrawing.SelectionSets While .Count > 0 .item(0).Delete Wend Set ss = .Add("$DynBlocks$") End With Dim ftype(0 To 1) As Integer Dim fdata(0 To 1) As Variant ftype(0) = 0: ftype(1) = 66 fdata(0) = "INSERT": fdata(1) = 1 ss.SelectOnScreen ftype, fdata If ss.Count = 0 Then MsgBox "Nie wybrano bloku...Kończymy" Exit Sub End If Set blkref = ss.item(0) 'Dim i As Integer props = blkref.GetDynamicBlockProperties MsgBox props(0).Value Dim prop As ZcadDynamicBlockReferenceProperty 'For i = LBound(props) To UBound(props) - 1 Set prop = props(0) pvalue = prop.Value Dim asTxt As String asTxt = CStr(pvalue) MsgBox (asTxt) 'Next i Next End If End If End Sub Na chama wrzucone to co Kruszynski wymyślił. Tym razem procedura pokazuje długość pręta po każdorazowej zmianie. Niestety mogę się odnieść jedynie do pierwszej długości props(0), wyłączyłem pętle, bo przy props(1) wywala już błąd. CEL: Po zmianie długości pręta lub wymiaru, chcę podmienić atrybut. Czuję, że jestem już blisko, ale działam na ślepo. Pomożecie? blok.dwg

Witam, czy znajdę funkcję podobną do addselected z autocad? Funkcja pobiera warstwę, kolor, grubość i typ linii z wybranego obiektu a następnie chce ją rysować. A może ma ktoś lispa który to robi?

Ok, znalazłem. Za dużo pętli w For I = 0 To ssetObj.Count powinno być For I = 0 To ssetObj.Count -1 Dziękuję bardzo. Ładnie działa!

Jeżeli ssetObj jest moim oSset to wyskakuje mi błąd Run-time error '-2147467259 (80004005)': Method 'Item" of object "IZcadSelectionSet' failed -> Set ent = oSset.item(i)

Dzięki wszystkim za odpowiedzi. Ten etap już mamy ogarnięty. Teraz chciałem wywoływać jakąś funkcję (choćby MsgBox) VBA za każdym razem jak ten właśnie blok zmodyfikuję (rozszerzę, wydłużę)

Cześć, używam kodu do zaznaczania bloków i filtruje je aby pobierało tylko te z nazwą "test". Czasem bloki te grupuję. Czy makro może wychwycić, że dany blok o nazwie "test" jest już w jakiejś grupie, wyrzuci mi błąd (msgbox) i wyjdzie z funkcji? Dim oSset As ZcadSelectionSet With ThisDrawing.SelectionSets While .count > 0 .item(0).Delete Wend Set oSset = .Add("*") End With ftype(0) = 2: fdata(0) = "test" dxfCode = ftype: dxfValue = fdata oSset.SelectOnScreen dxfCode, dxfValue

Aha... reaktorów

Aha, elegancko. Teraz jak już mam dostęp do bloku dynamicznego, jego parametrów i atrybutów to chodzi mi po głowie takie makro, które byłoby wczytywane wraz z oknem zwcada i śledziłoby zmianę któregokolwiek parametru (lub atrybutu) bloku o nazwie "Test_blok" i za każdym razem wyrzucałoby Msgbox typu "parametr bloku o współrzędnych x,y został zmieniony" lub "atrybut bloku o współrzędnych x,y został zmieniony". Byłby to blok superdynamiczny, który mógłby reagować na każdą zmianę Jest to w ogóle możliwe? Czy takie makro ciągle działające w tle nie zajmowałoby za dużo zasobów? Co o tym myślicie?

Chodziło mi o pobranie danych z czerwonej ramki. Z niebieskiej już miałem opanowane.

OK, więc w pliku blok dynamiczny, który posiada parametry rozciągania długości o nazwach Rozstaw i Dlugosc_preta (na zdjęciu w czerwonej ramce), blok będzie posiadał również atrybuty do przechowywania informacji itp. (niebieska ramka), ale o nich proszę nie myśleć - wiem jak się do nich dostać przez VBA. Teraz pytanie, czy mogę wczytać wartości z czerwonej ramki z pod VBA i wyświetlić je w msgBox, a może mogę je też podmienić? PS. Na początku chodziło mi o to, żeby któryś z atrybutów (z niebieskiej ramki) podczytywał na żywo po każdej zmianie długości (z czerwonej ramki) forum_cad_blok.dwg

Kiedyś rozmawiałem z e-cadem, chyba mają za dużo pracy żeby wprowadzać nowe pomysły

Mam e-cad, jednak tworzę coś na własne potrzeby. A co do mojego pytania?

Nie nie, nie o to chodzi. No dobrze.. a można wczytać wartość długości rozciąganych elementów do VBA? To znaczy, mam blok dynamiczny, w którym rozciągam dwie prostopadłe linie. Wartości te są edytowalne i można je zmieniać poprzez kliknięcie myszką lub wpisanie wartości. Te wartości są sobie tożsame. Czy można stworzyć makro VBA w którym to klikamy na blok i np. msgbox podaje nam wartości długości tych dwóch linii?

Chcę zrobić blok dynamiczny pręta do zbrojenia płyty. Pręt ma określoną długość, którą mogę rozciągać (a więc zmieniać jego długość) a prostopadle do niego mam linię wymiarową określającą jego rozstaw, którą też mogę rozciągać (też mam długość rozkładu). Po środku stoi blok z atrybutami. Czy mogę powiązać atrybuty bloku ze zmiennymi atrybutami? Aby blok wiedział, że zmieniła się długość pręta i wciągała do siebie jego wartość? Macie jakiś pomysł czy można to zautomatyzować?

Słuchajcie, działa! zamiast "_SELECT" należy wpisać "_.pSELECT" Dzięki za pomoc! Jesteście MISTRZAMI