Új hozzászólás Aktív témák

• #2454 új kérdező csendes tag

  Új Válasz 2014-06-01 15:15:47 #2454

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  új kérdező

  csendes tag

  Üdv mindenkinek!
  Két kérésem, kérdésem lenne. Az első
  fnev9k = fnev + "k"
  fnev9j = fnev + "j"
  fnev9i = fnev + "i"
  fnev9h = fnev + "h"
  fnev9g = fnev + "g"
  fnev9f = fnev + "f"
  fnev9e = fnev + "e"
  fnev9d = fnev + "d"
  fnev9c = fnev + "c"
  fnev9b = fnev + "b"
  fnev9a = fnev + "a"
  If Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9k & ".dxf") <> "" Then
  fnev = fnev9k
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9j & ".dxf") <> "" Then
  fnev = fnev9j
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9i & ".dxf") <> "" Then
  fnev = fnev9i
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9h & ".dxf") <> "" Then
  fnev = fnev9h
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9g & ".dxf") <> "" Then
  fnev = fnev9g
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9f & ".dxf") <> "" Then
  fnev = fnev9f
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9e & ".dxf") <> "" Then
  fnev = fnev9e
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9d & ".dxf") <> "" Then
  fnev = fnev9d
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9c & ".dxf") <> "" Then
  fnev = fnev9c
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9b & ".dxf") <> "" Then
  fnev = fnev9b
  ElseIf Dir("l:\sw2010rajz\dxf-k szöveghez\" & fnev9a & ".dxf") <> "" Then
  fnev = fnev9a
  Ezt a belinkelt részt, lehet e kevesebb sorral egyszerűbben megoldani, gondolok itt tömbre meg ciklusra például. A betűk indexeket jelölnek. Ez a programrész, arról szól, hogy van e az adott helyen indexes fájl és amilyent talál azzal folytatódik a feladat. Fontos a sorrend azaz, hogy előbb találja meg pl a b indexűt, mint az a indexűt és persze csak a b-s a jó. Azaz a legmagasabb indexűt keresse az legyen az eredmény.
  Másik gond. Részben kapcsolódik az előzőhöz csak itt az alap amihez az indexet kapcsolni kell kötőjelet tartalmaz. Pl: 12345-1 Ebből kellene ezt csinálni: 12345a-1 Itt az első feltétel, azt eldönteni, hogy kötőjeles vagy nem a kiinduló név, ezután megtalálni a kötőjelet és elé beszúrni az indexet. Annyi, ha ez segít, hogy a kötőjel előtti számok(karakterek) 4-5 lehet, a kötőjel utáni a kötőjellel együtt 2-4 karakter lehet.
  Ennyi. Előre is köszönöm a válaszokat.

• #2441 új kérdező csendes tag martonx #2440

  Új Válasz 2014-04-22 18:21:41 #2441

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  új kérdező

  csendes tag

  válasz martonx #2440 üzenetére

  Köszi a választ. Maga a ciklus jó lenne, csak az a baj, hogy a userformal nem foglalkozik, azaz nem várja meg amíg az elvégzi a dolgát. Azaz a ciklus első lefutásakor megmutatja a formot de nem lehet rá kattintani csak miután a ciklus végzett, akkor meg már késő. És ez a probléma, hogy a Userformot is lehessen használni és mikor az végez akkor ugorjon a ciklus.

• #2439 új kérdező csendes tag

  Új Válasz 2014-04-20 16:32:20 #2439

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  ú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 Sub

  A 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