酷居科技

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

从工程图中导出明细表

从工程图中导出明细表
'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) )

'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If

'get user input
RUsure = MessageBox.Show ( _
"This will create a .xls file for all of the asembly components that have drawings files." _
& vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
& vbLf & " " _
& vbLf & "Are you sure you want to create PDF Drawings for all of the assembly components?" _
& vbLf & "This could take a while.", "iLogic  - Batch Output PDFs ",MessageBoxButtons.YesNo)

If RUsure = vbNo Then
Return
Else
End If

'- - - - - - - - - - - - -subass drawing - - - - - - - - - - - -
Dim oExcDocs As DocumentsEnumerator
oExcDocs = oAsmDoc.AllReferencedDocuments
Dim oExcDoc As Document
For Each oExcDoc In oExcDocs
idwPathName = Left(oExcDoc.FullDocumentName, Len(oExcDoc.FullDocumentName) -3) & "idw"
'check to see that the model has a drawing of the same path and name
If(System.IO.File.Exists(idwPathName)) Then
				Dim oDrawDoc As DrawingDocument
                oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
		pathname = Left(oExcDoc.FullDocumentName, Len(oExcDoc.FullDocumentName) -3)
		Dim oSheet1 As Inventor.Sheet
		oSheet1 = oDrawDoc.Sheets("Ark:1")
		Dim oPartslist1 As PartsList
		oPartslist1 = oSheet1.PartsLists(1)
		oPartslist1.Export(pathname & ".xls",PartsListFileFormatEnum.kMicrosoftExcel)
		oDrawDoc.Close
Else
'If the model has no drawing of the same path and name - do nothing
End If
Next
'- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
oAsmDrawing = ThisDoc.ChangeExtension(".idw")
oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True)
oAsmDrawingName = Left(oAsmDrawingDoc.DisplayName, Len(oAsmDrawingDoc.DisplayName))
On Error Resume Next 
path_and_name = ThisDoc.PathAndFileName(False)
Dim oSheet As Inventor.Sheet
oSheet = oAsmDrawingDoc.Sheets("Ark:1")
Dim oPartslist As PartsList
oPartslist = oSheet.PartsLists(1)
oPartslist.Export(path_and_name & ".xls",PartsListFileFormatEnum.kMicrosoftExcel)
oAsmDrawingDoc.Close
'- - - - - - - - - - - - -

MessageBox.Show("Done " & vbLf & oFolder, "iLogic")
'open the folder where the new ffiles are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)

不想失业?你得学会为自己工作

不想失业?你得学会为自己工作

正在读这篇文章的你,从事着什么工作呢?

也许,你是一名白领,坐在冷气强劲的5A级写字楼,拿着一万出头的工资,每天朝九晚八,带着一身疲惫回家。虽然积蓄不多,却也在一直慢慢增长。

又或许,你是一名应届生,刚刚进入心仪的大公司,虽然奔波在最劳累的第一线岗位,但一想到未来的晋升路径和可能性,就踌躇满志。

也许,你们都在这座城市扎根不久,但都梦想着,通过自己的努力打拼,一步步在公司里站稳脚跟,向上晋升,当上高管,买房,成家,立业。

简易的BOM明细输出

简易的BOM明细输出

可用ilogic直接保存运行,代码如下:

Dim oDoc As Document = ThisApplication.ActiveDocument
If oDoc.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then Exit Sub
Dim oADO As Inventor.ComponentOccurrences = oDoc.ComponentDefinition.Occurrences
Dim ES As String = vbNullString
For Each aDoc As Document In oDoc.AllReferencedDocuments
Dim sFN As String = aDoc.FullFileName
Dim Amount As Integer = oADO.AllReferencedOccurrences(aDoc).Count
Dim oPropsets As PropertySets = aDoc.PropertySets
Dim oPropSet As PropertySet = oPropsets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}")
Dim PN As String = oPropSet("Part Number").Expression
If ES <> vbNullString Then ES += vbNewLine
ES += PN & " " & CStr(Amount)
Next
MsgBox(ES)

山外小楼夜听雨

山外小楼夜听雨

这个周期的水星逆行,在各种日食的加持下,显得格外强大。

先是换了座驾的电瓶,然后居然把12年不联系的老同学们都逆回来了。

不管你是否愿意,世间很多事,冥冥之中,上苍早已安排好。

此刻,炎热的夏天即将过去,初秋已至,严寒也不会太远。

风萧萧的雨夜,适合在山外小楼听雨。

你觉得呢?

timg

装配图及普通零件的重心标记(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