Hot News aus dem CAD.de-Newsletter:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  SaveAs erzeugt Empfehlung zu WHERST

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   SaveAs erzeugt Empfehlung zu WHERST (437 mal gelesen)
RalphRX8
Mitglied
Kontruktionsbüro


Sehen Sie sich das Profil von RalphRX8 an!   Senden Sie eine Private Message an RalphRX8  Schreiben Sie einen Gästebucheintrag für RalphRX8

Beiträge: 320
Registriert: 17.11.2004

erstellt am: 16. Aug. 2017 11:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo zusammen,

ich habe schon länger ein nerviges Problem und hoffe Ihr könnt mir helfen das zu beheben.
Ich kopiere teilweise mittels VBA mit einer Routine diverse Zeichnungen in eine neue Vorlgae und speichere diese dann mit SaveAs ab.
Wenn ich diese Zeichnungen dann öffne, bekomme ich folgende Meldung:

Während des Öffnenes wurde ein Fehler gefunden.
Wollen Sie den Öffnungsvorgang abbrechen.
Es wird empfohlen... den Befehl WHERST ... auszuführen.

Ich kann dann "Nein" anklicken und er macht die Zeichnung problemlos auf. Wenn ich dann auf speichern drücke, ist das Problem beseitigt.

Weiß jemand woran das liegen kann?

Vorab vielen Dank
Ralph

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 198
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 22. Aug. 2017 02:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für RalphRX8 10 Unities + Antwort hilfreich

Faktisch nein :/ Acad hat da einige Bugs..

Private Sub MODAUDIT_Click()
    On Error Resume Next
    thisdrawing.SendCommand "_AUDIT" & vbCr & "y" & vbCr
End Sub
mag helfen ..

Ich hatte da neulich auch so ein Problem ACAd stürzte nach einer bestimmten Aktion (Wie man Acad dazu bringt für Entitys VBS auszuführen sprengt den Rahmem) Aber faktisch war es so das es mir gelungen sein muss (Die VBS scripte ligen in dictionarys) etwas zu erzeugen was einen Sofortcrash hervorruft.
Abhilfe war nachdem der Block der es hervorruft zu clonen sprich mit  eine Kopie des Blockes zu erzeugen. Der Unfug der den Crash verursacht hat schien nicht mit über diese Routine zu gehen. Man frage mich bitte nicht warum ud wieso !
Fakt ist, es wurde überlebt.
Sub block_definition_clone(Optional interactiv As Boolean = False)

    Dim fileName As String
    Dim oBlkRef As AcadBlockReference
    Dim oEnt As AcadEntity, oBlock As AcadBlock
    Dim varpt(2) As Double
    Dim insVpt, inspt(2) As Double
    Dim BNAME As String
    Dim I As Long, J As Long, IDPairs As Long
    Dim expObjs As Variant

    Dim objSelSet As AcadSelectionSet
    Dim objTarget As AcadDocument
    Dim currentdrawing As AcadDocument
    Set currentdrawing = thisdrawing
    Dim documents As AcadDocuments '
    Dim document As AcadDocument
    Dim objOrgEnts() As Object
    Dim destEnts As Variant
    Dim intCnt As Long
    Dim blo As AcadBlock
    Dim strFullDef As String
    Dim objBlock As AcadBlock
    Dim objBlock1 As AcadBlock
    Dim colBlocks As AcadBlocks
    Dim objArray(0) As Object
    Dim v As Variant
    Dim oldname As String

    ' NN = InputBox("Enter new block name :", "Create New Block", "1")
    '  On Error GoTo Err_Control
    thisdrawing.SetVariable "DELOBJ", 1
    On Error GoTo Err_Control:
    'Thisdrawing.Utility.GetEntity oEnt, varPt, "Select block: "
    Set entity = get_entity("Select block", "acdbblockreference", v)
    If entity Is Nothing Then Exit Sub
    Dim sourcedoc As AcadDocument
    Set sourcedoc = application.activedocument
    Dim TEMPDOC As AcadDocument

    If TypeOf entity Is AcadBlockReference Then
        Set oBlkRef = entity
        oldname = oBlkRef.effectivename
        BNAME = oBlkRef.effectivename
        BNAME = BLOCK_NAME_UNIQUE(BNAME)
        If interactiv Then
            BNAME = InputBox("New block name is: ", "BLOCKCOPY", BNAME)
        End If
        insVpt = oBlkRef.insertionPoint
        For J = 0 To UBound(insVpt)
            inspt(J) = insVpt(J)
        Next

        For Each oBlock In thisdrawing.BLOCKS
            If oBlock.name = BNAME Then
                MsgBox "Block " & BNAME & " does already exist" & _
                    vbNewLine & "Exit program"
                Exit Sub
            End If
        Next
        Debug.Print
        Dim S As String
        S = REPLACE(Now(), ".", "")
        S = REPLACE(S, " ", "")
        S = REPLACE(S, ":", "")
       

        'temp document
        fileName = GetTmpPath() & "temp" & S & ".dwg"
        If Not FileExists(fileName) Then Call document_create(fileName)
        Dim ACDbx As Object
        Set ACDbx = AINTERFACE.IDoc()
        ACDbx.Open fileName
        Set TEMPDOC = application.activedocument

        'remove old definition if exist
        Set colBlocks = ACDbx.BLOCKS
        For Each objBlock In colBlocks
            If objBlock.name = BNAME Then
                objBlock.DELETE
                If interactiv Then MsgBox "OLD TEMP BlockDef " & BNAME & "FOUND and deleted"
            End If
        Next

        'COPY TO TEMPFILE
        application.activedocument = sourcedoc
        Set colBlocks = thisdrawing.BLOCKS
        Set objBlock = colBlocks.ITEM(oldname)
        If BNAME = "" Then Exit Sub
        objBlock.name = BNAME
        Set objArray(0) = objBlock
        R = thisdrawing.CopyObjects(objArray, ACDbx.modelspace)
        objBlock.name = oldname
        ACDbx.SaveAs fileName

        'RELOAD FROM TEMPFILE
        ACDbx.Open fileName

        For Each objBlock In ACDbx.BLOCKS
            If objBlock.name = BNAME Then
                If interactiv Then say "Block " & BNAME & "FOUND"
                Set objArray(0) = objBlock    'Create object array as required by the CopyObjects Method
                ACDbx.CopyObjects objArray, thisdrawing.BLOCKS
                If interactiv Then say "Block " & BNAME & "COPY"
            End If
        Next

        Dim blockref As AcadBlockReference
       
        Dim SNAME As String

        'sname = SLOPEDIR.BLK & "\posid.dwg"
        If interactiv Then
            If get_POINT("Insertation point of new block : " & BNAME, varpt) Then
                Set oBlkRef = block_insert(varpt, BNAME, 1#, 1#, 1#, 0#)
            End If
        End If

        '############################

    End If
    '############################
Err_Control:
    If err.Number = 0 Then
        say "Done"
    Else
        Debug.Print err.DESCRIPTION
    End If
End Sub

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 198
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 22. Aug. 2017 02:39    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für RalphRX8 10 Unities + Antwort hilfreich

    thisdrawing.SendCommand "_AUDIT" & vbCr & "y" & vbCr
mag auch helfern 

------------------
Wer es nicht versucht, hat schon verlorn 
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

RalphRX8
Mitglied
Kontruktionsbüro


Sehen Sie sich das Profil von RalphRX8 an!   Senden Sie eine Private Message an RalphRX8  Schreiben Sie einen Gästebucheintrag für RalphRX8

Beiträge: 320
Registriert: 17.11.2004

erstellt am: 22. Aug. 2017 08:32    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

An dieser Stelle mal danke.
Und das soll ich vor dem speichern machen?

Ich kann mir fast nicht vorstellen dass das hilft, denn wenn ich ähnliche Vorgänge ohne speichern und schließen der Zeichnungen via VBA mache, sondern manuell speichere, besteht das Problem nicht.

Nur zur Sicherheit. Mein Problem liegt darin, das ich mit VBA an der Zeichnung ein paar Dinge ändere (Blöcke auflösen, Layer anpassen, etc.).
Danach lasse ich die dwg mit VBA mit SaveAs abspeichern und schließen.

Wenn ich die Zeichnung dann das nächste mal öffne, kommt die Empfehlung zur Wiederherstellung.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

DerBrain87
Mitglied
Mathematiker


Sehen Sie sich das Profil von DerBrain87 an!   Senden Sie eine Private Message an DerBrain87  Schreiben Sie einen Gästebucheintrag für DerBrain87

Beiträge: 65
Registriert: 29.04.2015

Ich verwende die Autodesk Product Design Suite Ultimate 2017 bzw.
Inventor Professional 2017 & AutoCAD Mechanical 2017

erstellt am: 30. Aug. 2017 10:00    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für RalphRX8 10 Unities + Antwort hilfreich

Hallo RalphRX8,
wenn die Idee mit _AUDIT nicht funktioniert, könntest du auch versuchen, das Dokument nach dem Speichern unter zu schließen, nochmals zu öffnen, speichern und nochmals zu schließen.
Das ist zwar nicht sonderlich schön, könnte aber funktionieren.

Gruß DerBrain87

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2018 CAD.de