2. Fórumok
  3. Szoftverfejlesztés
  4. Visual Basic
Keresés

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

  • #2454 új kérdező csendes tag
    Új Válasz #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 #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 #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