Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Problem beim speichern -CPU-Nutzung-
Autor: Boro
Datum: 20.04.04 20:57
Hallo Anubis! Hier mal mein kompletter Quell Code: Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Const MAX_PATH = 2600 Public Function ReturnFolder(Note As String) As String Dim Browser As BROWSEINFO Dim lngFolder As Long Dim strPath As String With Browser .hOwner = ThisDrawing.hwnd .lpszTitle = Note .pszDisplayName = String(MAX_PATH, 0) End With strPath = String(MAX_PATH, 0) lngFolder = SHBrowseForFolder(Browser) If lngFolder Then SHGetPathFromIDList lngFolder, strPath ReturnFolder = Left(strPath, InStr(strPath, vbNullChar) - 1) End If End Function Private Sub Cbo_Change() If Cbo.Text = "R12 - DXF" Then cmd5.Enabled = True End If If Cbo.Text = "R13 - DXF" Then cmd5.Enabled = False End If End Sub Private Sub cmd2_Click() Dim Ergebnis Ergebnis = Shell("C:\WW4\WW40 c:\ww4\a1\mpr\" & tbo1.Text & ".mpr") End Sub Private Sub cmd5_Click() Dim Ergebnis Ergebnis = Shell("C:\WW4\A1\Bpp -i=C:\WW4\A1\bpp.ini -f=" & tbo1.Text) cmd2.Enabled = True End Sub Private Sub cmd3_Click() Dim objUCS As AcadUCS Dim origin(0 To 2) As Double Dim xAXIS(0 To 2) As Double Dim yAXlS(0 To 2) As Double Dim varPoint As Variant UserForm1.Hide varPoint = ThisDrawing.Utility.GetPoint(, "Please select new UCS origin: ") origin(0) = varPoint(0): origin(1) = varPoint(1): origin(2) = varPoint(2) xAXIS(0) = varPoint(0) + 1: xAXIS(1) = varPoint(1): xAXIS(2) = varPoint(2) yAXlS(0) = varPoint(0): yAXlS(1) = varPoint(1) + 1: yAXlS(2) = varPoint(2) Set objUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAXIS, yAXlS, "AutoCad2004VbaProgrammersReferenzVonJoeSutphinOdersoAehnlich") ThisDrawing.ActiveUCS = objUCS Set objUCS = Nothing UserForm1.Show End Sub Private Sub cmd4_Click() Dim objDxf As AcadSelectionSet Dim strTempName As String Dim strTempPath As String Dim strFilename As String Dim objExportFile As AcadDocument If (tbo1.Value = "") Then GoTo MyErrorHandler UserForm1.Hide Select Case Cbo.ListIndex Case 0 'Abspeichern des WBloks unter R 12.dxf strTempPath = tbo.Text & "\" & tbo1.Text strFilename = RemoveExtension(ThisDrawing.name) Set objDxf = ThisDrawing.SelectionSets.Add("dxfcnc"): objDxf.SelectOnScreen ThisDrawing.Wblock strTempPath, objDxf Set objExportFile = ThisDrawing.Application.Documents.Open(strTempPath) With objExportFile .SaveAs ThisDrawing.path & "\" & tbo1.Text, acR12_dxf .Close End With Kill strTempPath & ".dwg" strTempPath = RemoveExtension(strTempPath) objDxf.Delete Set objDxf = Nothing Set objExportFile = Nothing UserForm1.Show Case 1 'Abspeichern des WBloks unter R 13.dxf strTempPath = tbo.Text & "\" & tbo1.Text strFilename = RemoveExtension(ThisDrawing.name) Set objDxf = ThisDrawing.SelectionSets.Add("dxfcnc"): objDxf.SelectOnScreen ThisDrawing.Wblock strTempPath, objDxf Set objExportFile = ThisDrawing.Application.Documents.Open(strTempPath) With objExportFile .SaveAs ThisDrawing.path & "\" & tbo1.Text, acR13_dxf .Close End With Kill strTempPath & ".dwg" strTempPath = RemoveExtension(strTempPath) objDxf.Delete Set objDxf = Nothing Set objExportFile = Nothing UserForm1.Show Exit Sub MyErrorHandler: MsgBox "Bitte einen Dateinamen - maximal 8 Zeichen - eingeben", 64, "Hinweis" End Select End Sub Public Function RemoveExtension(FileName1 As String) As String RemoveExtension = Left(FileName1, Len(FileName1) - 4) End Function Private Sub cmd6_Click() strPfad = ReturnFolder("Bitte Verzechnis wählen") If strPfad <> "" Then 'wenn Rückgabewert nicht leer dann tbo.Text = strPfad & "\" & newname '& newname 'alternativ falls Backslash fehlt: End If End Sub Private Sub CommandButton1_Click() AvViewX1.src = "C:\WW4\dxf\" & tbo1.Text & ".dxf" End Sub Private Sub UserForm_Initialize() UserForm1.tbo.Text = "C:\ww4\dxf" StatusBar1.Panels(1).Text = "aktueller Zeichnungsname = " & ThisDrawing.name Cbo.Value = "R12 - DXF" With Cbo .AddItem "R12 - DXF", 0 .AddItem "R13 - DXF", 1 End With End Sub Private Sub cmd1_Click() End End Sub Wie gesagt: Für Hilfe wäre ich sehr dankbar. Gruß Boro

Problem beim speichern -CPU-Nutzung-	560	Boro	19.04.04 12:48
Re: Problem beim speichern -CPU-Nutzung-	396	Anubis	20.04.04 11:44
Re: Problem beim speichern -CPU-Nutzung-	415	Boro	20.04.04 20:57

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen