Hot News:
   

Mit Unterstützung durch:

   Foren auf CAD.de
  Inventor VBA
  Object required in Funktion

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

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
  
NVIDIA GTC Paris und ISC High Performance-Konferenz 2025, eine Pressemitteilung
Autor Thema:  Object required in Funktion (1476 mal gelesen)
axi92
Mitglied
Konstrukteur


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

Beiträge: 685
Registriert: 20.02.2010

Inventor 2014 64bit SP2
Vault Basic 2014 64bit SP1
HP Z200
Win 7 64bit
16GB RAM
CPU: i5 3,2GHz
GPU: Nvidia Quadro K600

erstellt am: 23. Dez. 2015 10:29    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

obnjectrequoihred.jpg
 
Ich hatte schon mal so ein roblem nur komme ich hier nicht mit der ähnlichen Lösung wie im anderen auf einen richtigen Weg.
http://ww3.cad.de/foren/ubb/Forum258/HTML/001660.shtml#000002

Code:

Sub Test()
    GetSubDocumentType (ThisApplication.ActiveDocument)
End Sub

Public Function GetSubDocumentType(oDoc) As String
    'access the active document
    'Dim oDoc As Document
    'Set oDoc = ThisApplication.ActiveDocument

    'get the document type
    Dim eDocumentType As DocumentTypeEnum
    Set eDocumentType = oDoc.DocumentType ' <------------- Object required
   
    Dim sDocumentType As String
    Select Case eDocumentType:
    Case kAssemblyDocumentObject
        sDocumentType = "Assembly Document"
    Case kDesignElementDocumentObject
        sDocumentType = "DesignElement Document"
    Case kDrawingDocumentObject
        sDocumentType = "Drawing Document"
    Case kForeignModelDocumentObject
        sDocumentType = "ForeignModel Document"
    Case kPartDocumentObject
        sDocumentType = "Part Document"
    Case kPresentationDocumentObject
        sDocumentType = "Presentation Document"
    Case kSATFileDocumentObject
        sDocumentType = "SATFile Document"
    Case kUnknownDocumentObject
        sDocumentType = "Unknown Document"
    End Select
   
    'get the document sub-type
    Dim sDocumentSubType As String
    sDocumentSubType = oDoc.SubType
    Dim sReadableType As String
    'part document sub-types
   
    'part
    Select Case sDocumentSubType:
    Case "{4D29B490-49B2-11D0-93C3-7E0706000000}"
        sReadableType = "part"
    'sheet metal
    Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "sheet metal"
    'generic proxy
    Case "{92055419-B3FA-11D3-A479-00C04F6B9531}"
        sReadableType = "generic proxy"
    'compatibility proxy
    Case "{9C464204-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "compatibility proxy"
    'catalog proxy
    Case "{9C88D3AF-C3EB-11D3-B79E-0060B0F159EF}"
        sReadableType = "catalog proxy"
    'assembly document sub-types
    Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}"
        sReadableType = "assembly"
    'drawing document sub-types
    Case "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}"
        sReadableType = "drawing"
    'design element document sub-types
    Case "{62FBB030-24C7-11D3-B78D-0060B0F159EF}"
        sReadableType = "design element"
    'presentation document sub-types
    Case "{76283A80-50DD-11D3-A7E3-00C04F79D7BC}"
        sReadableType = "presentation"
    End Select
    MsgBox ("Document Type: " & sDocumentType & vbNewLine & "Document SubType: " + sReadableType)
    GetSubDocumentType = sReadableType
End Function

------------------
Grüße aus Wien
Philipp
Email: Base64 Encoded:
cGhpcHNfOTJAeWFob28uZGU=

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik, Master Eng. IT-Security & Forensic




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

Beiträge: 2933
Registriert: 15.11.2006

Windows 10 x64, AIP 2020-2025

erstellt am: 06. Jan. 2016 13:45    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 axi92 10 Unities + Antwort hilfreich
Hallo

Versuch mal so:

Code:
Option Explicit

Sub Test()
    Dim Result As String
    Result = GetSubDocumentType(ThisApplication.ActiveDocument)
End Sub

Public Function GetSubDocumentType(ByVal oDoc As Document) As String
    'access the active document
    'Dim oDoc As Document
    'Set oDoc = ThisApplication.ActiveDocument

    'get the document type
    Dim eDocumentType As DocumentTypeEnum
    eDocumentType = oDoc.DocumentType ' <------------- Object required
 
    Dim sDocumentType As String
    Select Case eDocumentType:
    Case kAssemblyDocumentObject
        sDocumentType = "Assembly Document"
    Case kDesignElementDocumentObject
        sDocumentType = "DesignElement Document"
    Case kDrawingDocumentObject
        sDocumentType = "Drawing Document"
    Case kForeignModelDocumentObject
        sDocumentType = "ForeignModel Document"
    Case kPartDocumentObject
        sDocumentType = "Part Document"
    Case kPresentationDocumentObject
        sDocumentType = "Presentation Document"
    Case kSATFileDocumentObject
        sDocumentType = "SATFile Document"
    Case kUnknownDocumentObject
        sDocumentType = "Unknown Document"
    End Select
 
    'get the document sub-type
    Dim sDocumentSubType As String
    sDocumentSubType = oDoc.SubType
    Dim sReadableType As String
    'part document sub-types
 
    'part
    Select Case sDocumentSubType:
    Case "{4D29B490-49B2-11D0-93C3-7E0706000000}"
        sReadableType = "part"
    'sheet metal
    Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "sheet metal"
    'generic proxy
    Case "{92055419-B3FA-11D3-A479-00C04F6B9531}"
        sReadableType = "generic proxy"
    'compatibility proxy
    Case "{9C464204-9BAE-11D3-8BAD-0060B0CE6BB4}"
        sReadableType = "compatibility proxy"
    'catalog proxy
    Case "{9C88D3AF-C3EB-11D3-B79E-0060B0F159EF}"
        sReadableType = "catalog proxy"
    'assembly document sub-types
    Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}"
        sReadableType = "assembly"
    'drawing document sub-types
    Case "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}"
        sReadableType = "drawing"
    'design element document sub-types
    Case "{62FBB030-24C7-11D3-B78D-0060B0F159EF}"
        sReadableType = "design element"
    'presentation document sub-types
    Case "{76283A80-50DD-11D3-A7E3-00C04F79D7BC}"
        sReadableType = "presentation"
    End Select
    MsgBox ("Document Type: " & sDocumentType & vbNewLine & "Document SubType: " + sReadableType)
    GetSubDocumentType = sReadableType
End Function

------------------
MfG
Ralf

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

Anzeige:Infos zum Werbeplatz >>

AVC Assembly CAD APP für Allgemeine Werkzeuge, Möbel, Messestände

Combine parts into a block assembly. Give the block an automatic name based on a pattern with a sequential number. Replace the block with a new one while maintaining the attribute values.

axi92
Mitglied
Konstrukteur


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

Beiträge: 685
Registriert: 20.02.2010

Inventor 2014 64bit SP2
Vault Basic 2014 64bit SP1
HP Z200
Win 7 64bit
16GB RAM
CPU: i5 3,2GHz
GPU: Nvidia Quadro K600

erstellt am: 13. Jan. 2016 12:10    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
Super danke!

------------------
Grüße aus Wien
Philipp
Email: Base64 Encoded:
cGhpcHNfOTJAeWFob28uZGU=

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

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!
Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2025 CAD.de | Impressum | Datenschutz