- Megjött a Razer DeathAdder egerek legfrissebb nemzedéke
- Ismét minimalista miditorony érkezett a Fractal Design műhelyéből
- Alakul a SpaceX Starlink európai ellenfele
- Digital Fingerprinting: Így buktat le a böngésződ a neten - Tech Percek #18
- Prezentálta PCI Express 6.0-s SSD-vezérlőjét a Silicon Motion
- Milyen TV-t vegyek?
- Vezetékes FÜLhallgatók
- Vezetékes FEJhallgatók
- SoundBlaster X-Fi
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Milyen billentyűzetet vegyek?
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- A partnerektől függ, hogy lesz-e Arc csúcs-VGA az aktuális generációban
- OLED monitor topik
- Ha a fejlesztőkön múlik, akkor nem tér vissza a GPU-s PhysX
Új hozzászólás Aktív témák
-
új kérdező
csendes tag
Tisztelt Mindenki!
Ezúton szeretnék segítséget kérni. autocad 2010-ben írtam egy makrót (VB6) Ami annyit tesz, hogy egy excel táblából átvesz egy cella értéket és megnyitja a hozzá tartozó fájlt és beilleszti a másik oszlopban lévő szöveget blokként, itt jön egy modalis Userform amiben a felhasználó szétrobbantja a beillesztett blokkot. A userformot szerettem volna egy olyannal kiváltani, hogy egy adott billentyűre történjen meg a szétrobbantás de úgy hogy a megnyomás előtt a felhasználó a beillesztett blokkot tudja forgatni meg stb. De mivel ezt nem tudom ezért lett a modális Userform, mivel nagyon- nagyon gyenge vagyok a témában.
De igazából nem ezt a fő gondom.Erre a feladatra szeretnék egy ciklust kérni, azaz, hogy az exceltáblában menjen végig a sorokon amíg el nem fogynak az adatok, de úgy, hogy várja meg amíg a Userformon lévő művelet is lezajlik.
Sub Example_StartAngle()
Dim xlApp As Object
Dim xlBook As Object
Dim xlBooks As Object
Dim xlSheets As Object
Dim xlSheet As Object
Dim xlCells As Object
Dim xlRange As Object
Dim futott As Boolean
futott = True
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
futott = False
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "nem sikerült elindítani az exel-et"
End If
End If
' AutoCAD alkalmazás ablak megjelenítése
xlApp.Application.Visible = True
Set xlBooks = xlApp.Workbooks
If xlBooks.Count > 0 Then
Set xlBook = xlBooks.Item(1)
End If
If xlBooks.Count = 0 Then
Set xlBook = xlBooks.Open("C:\Users\ko\Documents\számbeíráshoz.xlsx")
End If
Set xlSheets = xlBook.worksheets
Set xlSheet = xlSheets.Item(sheetName) '<--- change a sheet name (might be a sheet number instead)
xlSheet.Application.Visible = True
Set xlCells = xlSheet.Cells
Set xlRange = xlCells.Range("$A1")
Dim AcadApp As AcadApplication
Dim MyDxf As AcadDocument
Set AcadApp = GetObject(, "AutoCAD.Application")
Dim fnev As String
fnev = Cells(s, 1)
If fnev = "" Then
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
MsgBox "vége"
Exit Sub
End If
Set MyDxf = AcadApp.Documents.Open("l:\sw2010rajz\dxf-k szöveghez\" & fnev & ".dxf")
ZoomExtents
Dim newLayer As AcadLayer
' Create a Layer and make it the active layer
Set newLayer = ThisDrawing.Layers.Add("gravir")
newLayer.Color = acRed
ThisDrawing.ActiveLayer = newLayer
ThisDrawing.Regen (True)
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint As Variant
Dim height As Double
textString = Cells(s, 2)
insertionPoint = ThisDrawing.Utility.GetPoint(, "Kattints a beillesztési ponthoz: ")
height = 5
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
ZoomExtents
Dim exportFile As String
exportFile = "c:\wmf-k\" & fnev & ""
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("NEWSS")
sset.Select acSelectionSetLast
'sset.Select acSelectionSetAll
' Export the current drawing to the file specified above.
ThisDrawing.Export exportFile, "WMF", sset
textObj.Delete
Dim blockRefObj As AcadBlockReference
Dim importFile As String
Dim InsertPoint As Variant
Dim scalefactor As Double
InsertPoint = ThisDrawing.Utility.GetPoint(, "Kattints a beillesztési ponthoz: ")
Set blockRefObj = ThisDrawing.Import("c:\wmf-k\" & fnev & ".wmf", InsertPoint, 2)
ZoomExtents
Load UserForm1
UserForm1.TextBox1.Text = "" & fnev & ""
UserForm1.Show
Kill "c:\wmf-k\" & fnev & ".wmf"
SaveAs ("l:\sw2010rajz\dxf-k szöveghez\k\" & fnev & ".dxf"), ac2000_dxf
ThisDrawing.Application.ActiveDocument.Close (True)
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim AcadApp As AcadApplication
Dim MyDxf As AcadDocument
Set AcadApp = GetObject(, "AutoCAD.Application")
UserForm1.Hide
fnev = TextBox1.Text
Dim intFilterType(0) As Integer
Dim varFilterData(0)
intFilterType(0) = 0
varFilterData(0) = "Insert"
Dim explodedObjects As Variant
Dim I As Integer
I = 0
Dim objSSet As AcadSelectionSet
Dim blkEntry As AcadBlockReference
Do Until I = 1 'explodes all blocks
Set objSSet = ThisDrawing.SelectionSets.Add("Block")
objSSet.Select acSelectionSetAll, , , intFilterType, varFilterData
For Each blkEntry In objSSet
explodedObjects = blkEntry.Explode
Dim C As Integer
For C = 0 To UBound(explodedObjects)
explodedObjects(C).Update
explodedObjects(C).Color = acByLayer
explodedObjects(C).Lineweight = acLnWtByLayer
explodedObjects(C).Update
Next
blkEntry.Delete
Next blkEntry
ThisDrawing.SelectionSets.Item("Block").Delete
I = I + 1
Loop
End SubA programban lehet, hogy még vannak felesleges sorok de sebaj. a válaszokat előre is köszönöm.
Új hozzászólás Aktív témák
- OHH! Dell Precision 7560 Tervező Vágó Laptop -70% 15,6" i7-11850H 32/1TB NVIDIA A3000 6GB FHD
- Asztali PC , i7 6700K , 1080 Ti 11GB , 32GB DDR4 , 500GB NVME , 500GB HDD
- Asztali PC , R5 8400F , RTX 3070 , 32GB DDR5 , 500GB NVME , 2TB HDD
- Legion Go 1TB
- Lenovo LOQ 15IRX9 - i5 13450HX, 16GB, RTX 4060 8G, 1TB M.2 (Gari: 2027.03.11.)
- Lenovo V130-15IGM laptop (Pentium Silver N5000/8GB/256GB SSD
- Erő és sebesség? Most az Öné lehet! Ráadásul kamatmentes rèszletre is!
- Telefon felváráslás!! Samsung Galaxy S22/Samsung Galaxy S22+/Samsung Galaxy S22 Ultra
- Wilbur Smith könyvek (15 db) egyben
- 3DKRAFT.HU - 3D NYOMTATÁS - AZONNALI ÁRAJÁNLAT - GYORS KIVITELEZÉS - 480+ POZITÍV ÉRTÉKELÉS
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest