酷居科技

每个人都有属于自己的世界

装配图及普通零件的重心标记(VBA)

装配图及普通零件的重心标记(VBA)

Public Sub WorkPointAtMassCenter()
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
    ' 获取重心.
    Dim oCenterOfMass As Point
    Set oCenterOfMass = oDoc.ComponentDefinition.MassProperties.CenterOfMass
    On Error Resume Next
     Dim oWorkPoint As WorkPoint
    Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.Item("Center Of Mass")
    If Err.Number = 0 Then
        Dim oFixedDef As FixedWorkPointDef
        Set oFixedDef = oWorkPoint.Definition
        oFixedDef.Point = oCenterOfMass
        oDoc.Update
    Else
       Set oWorkPoint = oDoc.ComponentDefinition.WorkPoints.AddFixed(oCenterOfMass)
        oWorkPoint.name = "Center Of Mass"
    End If
End Sub

欧美作品,怎么都爱联军对抗异族呢?

欧美作品,怎么都爱联军对抗异族呢?
于是《权力的游戏》终于推进到了我们喜闻乐见的剧情:维斯特洛大陆自相残杀许久后,女王们终于打算捐弃前嫌,携手并肩,去对付长城外的异鬼大军了。我们的两位男主角――一无所知的雪诺,毒舌但心软的小恶魔――自然在其中大有功劳:斡旋、沟通、协调,一起去打鬼子。

权力的游戏

权力的游戏

长夏已尽,凛冬将至。

在这个炎热的夏季,想想冬天就要到了,真他妈的舒服。

 

在Inventor装配体中直接打开子部件或子零件工程图

在Inventor装配体中直接打开子部件或子零件工程图

最近比较忙,忙着处理非设计事务,不过偶尔会有打开工程图查看相关尺寸的需求。通常都是打开一个大型装配体,然后在装配体里面层层往下打开相关零件,然后再打开工程图。感觉这样很繁琐。

脑海中突然想结束这样的一个繁琐的流程。于是在处理其它事情的时候,潜意识里已经在构造相关方法。

然后想了一下,其实蛮简单的一个过程。

基本功能:首先,定位在顶级装配上,然后选中对应的零件或者零部件,然后点击一个按钮即可打开工程图。

逻辑:按钮内要包含相关程序,首先得判断指定零件或者零部件是否存在对应的工程图,如果存在,那么打开。否则提醒用户,不存在相应工程图。

从头再来

从头再来

这两天突然想重新开始一件事。

时光不停的流。

感觉应该再回去。

那里有曾经的激情与热血。

不想就这么碌碌无为的度过此生。

重附着引出序号

重附着引出序号
Public Sub AutoReattachAnnotation() Dim odoc As Document Set odoc = ThisApplication.ActiveDocument If ThisApplication.Documents.Count = 0 Then MsgBox "A document must be open", vbExclamation Else If odoc.DocumentType <> kDrawingDocumentObject Then MsgBox "Must be in Drawing document", vbExclamation Else Dim oDrawDoc As DrawingDocument Set oDrawDoc = ThisApplication.ActiveDocument Dim oSelectset As SelectSet Set oSelectset = oDrawDoc.SelectSet oSelectset.Clear Dim oBalloon As Balloon Dim aantal As Integer aantal = oDrawDoc.ActiveSheet.Balloons.Count Dim oTG As TransientObjects Set oTG = ThisApplication.TransientObjects Dim oBalloonCollection As ObjectCollection Set oBalloonCollection = oTG.CreateObjectCollection Dim i As Integer For i = 1 To oDrawDoc.ActiveSheet.Balloons.Count Set oBalloon = oDrawDoc.ActiveSheet.Balloons.Item(i) Call oBalloonCollection.Add(oBalloon) Next Call oSelectset.SelectMultiple(oBalloonCollection) Call ThisApplication.CommandManager.ControlDefinitions.Item("DLxAnnoReconnectCmd").Execute oSelectset.Clear End If End If End Sub

自动判断信息一致性

自动判断信息一致性

  Private Sub m_AppEvents_OnActivateDocument(ByVal DocumentObject As Inventor.Document, ByVal BeforeOrAfter As Inventor.EventTimingEnum, ByVal Context As Inventor.NameValueMap, ByRef HandlingCode As Inventor.HandlingCodeEnum) Handles m_AppEvents.OnActivateDocument
        Button3.PerformClick()
        Dim odocument As Document = _invApp.ActiveDocument
        Dim oshortname As String = getshortname(odocument)
        Dim idaihao As String
        Dim imingcheng As String
        If InStr(1, oshortname, " ") > 0 Then
            Do While InStr(oshortname, "  ") '如果有连续的两个空格就替换成一个空格
                oshortname = Replace(oshortname, "  ", " ")
            Loop
            idaihao = oshortname.Split(" ")(0)
            imingcheng = oshortname.Split(" ")(1)
        Else
            imingcheng = oshortname
            idaihao = ""
        End If
        Dim iprodaihao As String = getipro(odocument, "代号", "Inventor User Defined Properties")
        If iprodaihao = idaihao Then
            TextBox1.ForeColor = System.Drawing.Color.Green
        Else
            TextBox1.ForeColor = System.Drawing.Color.Red
        End If

将某文件夹下所有装配体文件bom表导出

将某文件夹下所有装配体文件bom表导出
Imports System.Windows.Forms
Imports System.IO

Public Sub Main
    Dim oPath As String
    
    ' Search for the folder
    Dim Dialog = New FolderBrowserDialog()
    Dialog.ShowNewFolderButton = True
    Dialog.Description = "Jef_E Bom's export tool"

    ' Show dialog box
    If DialogResult.OK = Dialog.ShowDialog() Then
        ' User clicked 'ok' on dialog box - capture the export path
        oPath = Dialog.SelectedPath & "\"
    
    Else
        ' User clicked 'cancel' on dialog box - exit
        Return
    End If

    ' Make a reference to a directory.
    Dim oDirectoryInfo As New DirectoryInfo(oPath)
    
    ' Get a reference to each file in that directory.
    Dim oFileArray As FileInfo() = oDirectoryInfo.GetFiles()
    
    ' Display the names of the files.
    Dim oFileInfo As FileInfo
    
    ' Loop through all files in the directory (not in the sub directories.)
    For Each oFileInfo In oFileArray
        If oFileInfo.Name.contains(".iam") Then
        
            ' Open the file
            ThisApplication.Documents.Open(oFileInfo.FullName, True) 
            
            ' Export the BOM
            
            ' Set a reference to the assembly document.
            ' This assumes an assembly document is active.
            Dim oDoc As AssemblyDocument
            oDoc = ThisApplication.ActiveDocument
            
            ' Set a reference to the BOM
            Dim oBOM As BOM
            oBOM = oDoc.ComponentDefinition.BOM
            
            ' Set the structured view to 'all levels'
            oBOM.StructuredViewFirstLevelOnly = False
        
            ' Make sure that the structured view is enabled.
            oBOM.StructuredViewEnabled = True
        
            ' Set a reference to the "Structured" BOMView
            Dim oStructuredBOMView As BOMView
            oStructuredBOMView = oBOM.BOMViews.Item("Structured")
            
            Dim oExcelPath As String
            oExcelPath = oPath & System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)& ".xls"
            
            ' Export the BOM view to an Excel file
            oStructuredBOMView.Export(oExcelPath, kMicrosoftExcelFormat)
            
            ' Close the document
            oDoc.Close
        
        End If
    Next
End Sub

Inventor判断指定工程图标题栏是否存在

Inventor判断指定工程图标题栏是否存在

一般,titleblockdefiition都会有一个name(名称),用这个名称去确认某个工程图中的标题栏是否是指定的。这里采用一个函数去判断,会比较简单,如下:

Function TBExists(oTBName) As Boolean

Exists = False

dim oTB as TitleBlockDefinitions

For Each oTB in oDrawDoc.TitleBlockDefinitions

Inventor API调用缩略图Thumbnail

Inventor API调用缩略图Thumbnail

 方法一:iproperty中获取

Dim invPartDoc As Document = _invApp.ActiveDocument
        Dim ifilename As String = invPartDoc.FullDocumentName
        Dim apprentice As New ApprenticeServerComponent
         Dim doc As ApprenticeServerDocument
        doc = apprentice.Open(ifilename)
        Dim summaryInfo As PropertySet
        summaryInfo = doc.PropertySets.Item(
        Dim thumbProp As Inventor.Property
        thumbProp = summaryInfo.Item("Thumbnail")
        Dim thumbnail As stdole.IPictureDisp
        thumbnail = thumbProp.Value
        Dim img As Image = VB6.IPictureDispToImage(thumbnail)
        PictureBox1.Image = img