片材套装中的自定义道具

Murph · 发表于 2008-2-22 18:30:19

嗨
有人能够在图纸集中编辑自定义属性吗？
有CUSTOM_SHEET_PROP和CUSTOM_SHEET_PROP
CUSTOM_SHEET_PROP是特定于每张图纸(布局)的字段
CUSTOM _ SHEET _ PROP是所有图纸的字段
一个很好的例子是，在您的绘图总数中有1个#(例如)
嗯，您可以将1定义为CUSTOM _ SHEET _ PROP(字段),将#定义为CUSTOM _ SHEET _ PROP(字段),作为每张图纸(布局)的第一个数字更改，并将
因此，每次用户更新#(字段)时，布局将动态地重新索引。
一旦你开始掌握它的窍门；真的很酷。
无论如何，我们将项目数据写出到一个txt文件，通过属性，我们可以读入这些信息；现在，我需要能够这样做的领域(自定义_道具)
我已经取得了一些进展，很高兴分享我所拥有的，但我只是不能到最后一个拥挤。
任何帮助都将不胜感激。
谢谢！
Mark
PS:我在网上查过高低；vba示例等。

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

Murph · 发表于 2008-2-23 10:34:21

请给我发送一条私人消息，我将发布我的整套代码，以便在周一下班后完成所有这些工作。我使用我在博客上找到的信息（我也会发布该链接）为我们公司编写了整个界面。我们将信息导出到Excel中，以便非CAD人员可以对其进行编辑，并且还有一个导入例程。
它主要用于从不同办公室导入图纸集。
墨菲

Murph · 发表于 2008-2-24 13:12:14

马克，
附件是我从这个网站放在一起的东西：
http://jtbworld.blogspot.com/2005/01/sheet-set-manager-api-code-sample-for_20.html
看看并提出问题。希望它有帮助。
http://www.theswamp.org/lilly_pond/index.php?dir=murphy/&file=CustomSSM.dvb
墨菲

Murph · 发表于 2008-2-25 05:52:22

好吧，墨菲！
你的代码看起来很棒
当然，那里有很多需要的东西。
我只是希望能够首先编辑自定义道具，然后我肯定会更仔细地查看您发送的所有代码。
好吧，我现在将查看Utils函数
谢谢！
马克

Murph · 发表于 2008-2-25 09:30:54

我跳得有点快，但我刚刚注意到您正在使用脚本语言
这很酷；我也经常使用它
我注意到这是一些您正在获取用户名和机器的示例。
它在这里不起作用，但我没有起诉您是如何获取该信息的。
我一直使用脚本代码来检索该信息。
标记

Murph · 发表于 2008-2-25 10:16:13

嘿，Murph
再说一次，您的代码非常好，从中可以学到很多东西。
但是，它仍然有点复杂，因为所有的Excel工作都在进行中。
我正在寻找一个非常基本的例子，改变表和表中的自定义道具。
在我了解这一点后，我可以对其进行阐述。
你有没有稍微简单一点的？
谢谢！
标记

Murph · 发表于 2008-2-25 10:26:01

标记，
让我们一步一步地完成它，这样您就可以从中得到您想要的东西。
我们从SheetSetForm.SSStartHere.开始
这是检查您是否有一个工作表设置为打开状态，并确保只有一个是打开的。
它将锁定它，然后将其发送到Loop穿透SheetsPop
这是我们获取要呈现给用户以进行更改的值的地方。
请注意，GetCSSProperties正在发送一个字符串和一个工作表。该字符串是自定义工作表属性的EXACT Title。
您可以根据公司的自定义工作表属性自定义整个表单。
让我们假设某些值已更改并且用户点击OK按钮。该代码将我们发送到SetProps。
此例程检查一个且仅一个工作表集并锁定它。
因为这东西正在将工作表集的内容导出到Excel以在另一个办公室导入，所以我们现在将跳过它。
SetProps将我们发送到Loop穿透SheetsSet，它将执行此操作。
它将遍历所有工作表并将值设置为表单中的值。

copy

Private Sub LoopThroughSheetsSet(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Dim lastrevn As Variant
    Dim lyOut As AcSmAcDbLayoutReference
    Dim lyName As String
    Dim lastrevd As String
    Dim lastrevdate As String
    Dim rNumTemp As String
    Dim rnNext As String
    Dim rnVar As Variant
    Dim dirmade As Boolean
    Dim tLine1 As String
    Dim tLine2 As String
    Dim tLine3 As String
    Dim selsets As AcSmSheetSelSets
    Dim selset As AcSmSheetSelSet
    Dim tselset As AcSmSheetSelSet
    Dim ssMade As Boolean
    Dim ttitle As String
    Dim repTemp As String
    On Error GoTo ErrHandler
    ssMade = False
    Set comp = compEnum.Next()
    dirmade = False
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        'if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            'loop through all the sheets.
            'Call LoopThroughSheetsPop(sset.GetSheetEnumerator)
            Dim s As AcSmSheet
            Set s = comp
            Dim sNumber As String
            Dim sTitle As String
            sNumber = s.GetNumber
            'tLine1 = GetCSSProperties("Drawing Title Line 1", s)
            'tLine2 = GetCSSProperties("Drawing Title Line 2", s)
            'tLine3 = GetCSSProperties("Drawing Title Line 3", s)
            'If tLine1 = "%%032" Then
            '    tLine1 = ""
            'End If
            'If tLine2 = "%%032" Then
            '    tLine2 = ""
            'End If
            'If tLine3 = "%%032" Then
            '    tLine3 = ""
            'End If
            'If Not tLine1 = "" Then
            '    If Not tLine2 = "" Then
            '        If Not tLine3 = "" Then
            '            ttitle = tLine1 & " " & tLine2 & " " & tLine3
            '        Else
            '            ttitle = tLine1 & " " & tLine2
            '        End If
            '    Else
            '        If Not tLine3 = "" Then
            '            ttitle = tLine1 & " " & tLine3
            '        Else
            '            ttitle = tLine1
            '        End If
            '    End If
            'Else
            '    If Not tLine2 = "" Then
            '        If Not tLine3 = "" Then
            '            ttitle = tLine2 & " " & tLine3
            '        Else
            '            ttitle = tLine2
            '        End If
            '    Else
            '        If Not tLine3 = "" Then
            '            ttitle = tLine3
            '        End If
            '    End If
            'End If
            '
            'If Not ttitle = "" Then
            '    s.SetTitle ttitle
            'End If
            sTitle = s.GetTitle
            Set lyOut = s.GetLayout
            lyName = lyOut.ResolveFileName
            If sNumber = dNum Then
                If Not pstamp = "" Then
                    ChangeProperties "Preliminary Stamp", pstamp, s
                End If
                If Not pLines = "" Then
                    ChangeProperties "ProjectLayer", pLines, s
                End If
                If Not tLines = "" Then
                    ChangeProperties "TitleLayer", tLines, s
                End If
                If Not ssetName = "" Then
                    newSelSet.Add s
                End If
                If Not chk = "" Then
                    ChangeProperties "Checked By", chk, s
                End If
                If Not des = "" Then
                    ChangeProperties "Designed By", des, s
                End If
                If Not chrg = "" Then
                    ChangeProperties "In Charge Of", chrg, s
                End If
                If Not dwn = "" Then
                    ChangeProperties "Drawn By", dwn, s
                End If
                If Not scl = "" Then
                    ChangeProperties "Scale", scl, s
                End If
                If Not ptitle = "" Then
                    ChangeProperties "Location", ptitle, s
                    'ChangeProperties "Drawing Title Line 1", ptitle, s
                End If
                If Not repTxt = "" Then
                    repTemp = PropReplaceCombo.Column(0, PropReplaceCombo.ListIndex)
                    ChangeProperties repTemp, repTxt, s
                End If
                If Not rdesc = "" Then
                    If wipeClean = True Then
                        ChangeProperties "Revision Number 0", "0", s
                        ChangeProperties "Description of revision 0", rdesc, s
                        ChangeProperties "Date of Revision 0", rdate, s
                        ChangeProperties "Initials of Rev 0 Reviewer", rinit, s
                        
                        ChangeProperties "Revision Number 1", "%%032", s
                        ChangeProperties "Description of Revision 1", "%%032", s
                        ChangeProperties "Date of Revision 1", "%%032", s
                        ChangeProperties "Initials of Rev 1 Reviewer", "%%032", s
                        
                        ChangeProperties "Revision Number 2", "%%032", s
                        ChangeProperties "Description of Revision 2", "%%032", s
                        ChangeProperties "Date of Revision 2", "%%032", s
                        ChangeProperties "Initials of Rev 2 Reviewer", "%%032", s
                        
                        ChangeProperties "Revision Number 3", "%%032", s
                        ChangeProperties "Description of Revision 3", "%%032", s
                        ChangeProperties "Date of Revision 3", "%%032", s
                        ChangeProperties "Initials of Rev 3 Reviewer", "%%032", s
                        
                        ChangeProperties "Revision Number 4", "%%032", s
                        ChangeProperties "Description of Revision 4", "%%032", s
                        ChangeProperties "Date of Revision 4", "%%032", s
                        ChangeProperties "Initials of Rev 4 Reviewer", "%%032", s
                    Else
                        If GetCSSProperties("Date of Revision 4", s) = "%%032" Then
                            If GetCSSProperties("Date of Revision 3", s) = "%%032" Then
                                If GetCSSProperties("Date of Revision 2", s) = "%%032" Then
                                    If GetCSSProperties("Date of Revision 1", s) = "%%032" Then
                                        If GetCSSProperties("Date of Revision 0", s) = "%%032" Then
                                            If rtype = "L" Then
                                                ChangeProperties "Revision Number 0", "A", s
                                            Else
                                                ChangeProperties "Revision Number 0", "0", s
                                            End If
                                            ChangeProperties "Description of revision 0", rdesc, s
                                            ChangeProperties "Date of Revision 0", rdate, s
                                            ChangeProperties "Initials of Rev 0 Reviewer", rinit, s
                                        Else
                                            rNumTemp = GetCSSProperties("Revision Number 0", s)
                                            If rtype = "L" Then
                                                rnNext = AddLetter(rNumTemp)
                                            Else
                                                If IsNumeric(rNumTemp) Then
                                                    rnVar = rNumTemp
                                                    rnVar = rnVar + 1
                                                    rnNext = rnVar
                                                Else
                                                    rnNext = "0"
                                                End If
                                            End If
                                            ChangeProperties "Revision Number 1", rnNext, s
                                            ChangeProperties "Description of Revision 1", rdesc, s
                                            ChangeProperties "Date of Revision 1", rdate, s
                                            ChangeProperties "Initials of Rev 1 Reviewer", rinit, s
                                        End If
                                    Else
                                        rNumTemp = GetCSSProperties("Revision Number 1", s)
                                        If rtype = "L" Then
                                            rnNext = AddLetter(rNumTemp)
                                        Else
                                            If IsNumeric(rNumTemp) Then
                                                rnVar = rNumTemp
                                                rnVar = rnVar + 1
                                                rnNext = rnVar
                                            Else
                                                rnNext = "0"
                                            End If
                                        End If
                                        ChangeProperties "Revision Number 2", rnNext, s
                                        ChangeProperties "Description of Revision 2", rdesc, s
                                        ChangeProperties "Date of Revision 2", rdate, s
                                        ChangeProperties "Initials of Rev 2 Reviewer", rinit, s
                                    End If
                                Else
                                    rNumTemp = GetCSSProperties("Revision Number 2", s)
                                    If rtype = "L" Then
                                        rnNext = AddLetter(rNumTemp)
                                    Else
                                        If IsNumeric(rNumTemp) Then
                                            rnVar = rNumTemp
                                            rnVar = rnVar + 1
                                            rnNext = rnVar
                                        Else
                                            rnNext = "0"
                                        End If
                                    End If
                                    ChangeProperties "Revision Number 3", rnNext, s
                                    ChangeProperties "Description of Revision 3", rdesc, s
                                    ChangeProperties "Date of Revision 3", rdate, s
                                    ChangeProperties "Initials of Rev 3 Reviewer", rinit, s
                                End If
                            Else
                                rNumTemp = GetCSSProperties("Revision Number 3", s)
                                If rtype = "L" Then
                                    rnNext = AddLetter(rNumTemp)
                                Else
                                    If IsNumeric(rNumTemp) Then
                                        rnVar = rNumTemp
                                        rnVar = rnVar + 1
                                        rnNext = rnVar
                                    Else
                                        rnNext = "0"
                                    End If
                                End If
                                ChangeProperties "Revision Number 4", rnNext, s
                                ChangeProperties "Description of Revision 4", rdesc, s
                                ChangeProperties "Date of Revision 4", rdate, s
                                ChangeProperties "Initials of Rev 4 Reviewer", rinit, s
                            End If
                        Else
                            rNumTemp = GetCSSProperties("Revision Number 4", s)
                            If rtype = "L" Then
                                rnNext = AddLetter(rNumTemp)
                            Else
                                If IsNumeric(rNumTemp) Then
                                    rnVar = rNumTemp
                                    rnVar = rnVar + 1
                                    rnNext = rnVar
                                Else
                                    rnNext = "0"
                                End If
                            End If
                            ChangeProperties "Revision Number 0", GetCSSProperties("Revision Number 1", s), s
                            ChangeProperties "Description of revision 0", GetCSSProperties("Description of Revision 1", s), s
                            ChangeProperties "Date of Revision 0", GetCSSProperties("Date of Revision 1", s), s
                            ChangeProperties "Initials of Rev 0 Reviewer", GetCSSProperties("Initials of Rev 1 Reviewer", s), s
                            
                            ChangeProperties "Revision Number 1", GetCSSProperties("Revision Number 2", s), s
                            ChangeProperties "Description of Revision 1", GetCSSProperties("Description of Revision 2", s), s
                            ChangeProperties "Date of Revision 1", GetCSSProperties("Date of Revision 2", s), s
                            ChangeProperties "Initials of Rev 1 Reviewer", GetCSSProperties("Initials of Rev 2 Reviewer", s), s
                            
                            ChangeProperties "Revision Number 2", GetCSSProperties("Revision Number 3", s), s
                            ChangeProperties "Description of Revision 2", GetCSSProperties("Description of Revision 3", s), s
                            ChangeProperties "Date of Revision 2", GetCSSProperties("Date of Revision 3", s), s
                            ChangeProperties "Initials of Rev 2 Reviewer", GetCSSProperties("Initials of Rev 3 Reviewer", s), s
                            
                            ChangeProperties "Revision Number 3", GetCSSProperties("Revision Number 4", s), s
                            ChangeProperties "Description of Revision 3", GetCSSProperties("Description of Revision 4", s), s
                            ChangeProperties "Date of Revision 3", GetCSSProperties("Date of Revision 4", s), s
                            ChangeProperties "Initials of Rev 3 Reviewer", GetCSSProperties("Initials of Rev 4 Reviewer", s), s
                            
                            ChangeProperties "Revision Number 4", rnNext, s
                            ChangeProperties "Description of Revision 4", rdesc, s
                            ChangeProperties "Date of Revision 4", rdate, s
                            ChangeProperties "Initials of Rev 4 Reviewer", rinit, s
                        End If
                        ChangeRevProps rnNext, rdate, s
                    End If
                End If
            End If
    ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            'loop through all the sheets.
            Call LoopThroughSheetsSet(sset.GetSheetEnumerator)
        End If
        'next
        Set comp = compEnum.Next()
    Loop
    GoTo Exit_Here
ErrHandler:
Select Case Err.Number
    Case -2147467259
        Err.Clear
        Resume
    Case Else
        MsgBox Err.Number & ":" & Err.Description, vbOKOnly, "Error " & Err.Number
        GoTo Exit_Here
End Select
Exit_Here:
End Sub

这是完成工作的地方。
请注意它是如何调用ChangeProperties的，将属性标题作为字符串、所需值和工作表发送的。
如果您遍历并将所有“修订版编号0”替换为自定义表属性的标题，然后运行SheetSetSheet.SSFormStart
您将看到它在做什么。
让我为您编写一组例程，它将询问您想要获取值的自定义属性，并要求您通过InputBox更改它。

Murph · 发表于 2008-2-25 10:29:35

标记，
插入一个新模块并将此代码粘贴到其中。
这将要求您更改属性标题，为您提供现有值并让您进行更改。
这是一个向您展示其余部分如何工作的示例。墨菲

copy

Dim aCount As Integer
Dim cCount As Integer
Dim eCount As Integer
Dim iCount As Integer
Dim mCount As Integer
Dim pCount As Integer
Dim sCount As Integer
Dim pidCount As Integer
Dim dwgCount As Integer
Dim scl As String
Dim chk As String
Dim des As String
Dim chrg As String
Dim dwn As String
Dim rinit As String
Dim ssetName As String
Dim ptitle As String
Dim rdesc As String
Dim rdate As String
Dim rtype As String
Dim dNum As String
Dim draw As AcadDocument
Dim newDir As String
Dim newSelSet As IAcSmSheetSelSet
Dim pstamp As String
Dim pLines As String
Dim tLines As String
Dim donce As Boolean
Dim wipeClean As Boolean
Dim sdcCount As Integer
Dim sdcChange As Boolean
Dim NewSubsetStr As String
Dim sdcCalled As Boolean
Dim startDone As Boolean
Dim sdcPrev As Boolean
Dim repTxt As String
Dim expSel As Boolean
Dim xBook As Workbook
Dim dSht As Worksheet
Dim ppSht As Worksheet
Dim ssSht As Worksheet
Dim SingDrawComboPrev As Integer
Public Sub SetProps()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    'lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If
    Dim compEnum As IAcSmEnumComponent
    'get component enumerator
    Set compEnum = ss.GetSheetEnumerator
        Call LoopThroughSheetsSetMark(compEnum)
    'unlock the database
    Call db.UnlockDb(db, True)
End Sub
Private Sub LoopThroughSheetsSetMark(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Dim lastrevn As Variant
    Dim lyOut As AcSmAcDbLayoutReference
    Dim lyName As String
    Dim lastrevd As String
    Dim lastrevdate As String
    Dim rNumTemp As String
    Dim rnNext As String
    Dim rnVar As Variant
    Dim dirmade As Boolean
    Dim tLine1 As String
    Dim tLine2 As String
    Dim tLine3 As String
    Dim selsets As AcSmSheetSelSets
    Dim selset As AcSmSheetSelSet
    Dim tselset As AcSmSheetSelSet
    Dim ssMade As Boolean
    Dim ttitle As String
    Dim repTemp As String
Dim cssProp As String
Dim exstVal As String
Dim newVal As String
    On Error GoTo ErrHandler
    ssMade = False
    Set comp = compEnum.Next()
    dirmade = False
    cssProp = InputBox("What is the EXACT title of your custom property?", "Property Title")
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        'if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Dim s As AcSmSheet
            Set s = comp
            Dim sNumber As String
            Dim sTitle As String
            exstVal = GetCSSProperties(cssProp, s)
            sTitle = s.GetTitle
            
            newVal = InputBox("The drawing " & sTitle & vbCr & "has a value of" & vbCr & exstVal & vbCr & _
            "for the Custom Property titled" & vbCr & cssProp & vbCr & vbCr & "Please enter the new value here. Leave blank for no change" _
            , "Properties to the Extreme")
            
            If Not newVal = "" Then
                ChangeProperties cssProp, newVal, s
            End If
         
    ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            'loop through all the sheets.
            Call LoopThroughSheetsSet(sset.GetSheetEnumerator)
        End If
        'next
        Set comp = compEnum.Next()
    Loop
    GoTo Exit_Here
ErrHandler:
Select Case Err.Number
    Case -2147467259
        Err.Clear
        Resume
    Case Else
        MsgBox Err.Number & ":" & Err.Description, vbOKOnly, "Error " & Err.Number
        GoTo Exit_Here
End Select
Exit_Here:
End Sub

Murph · 发表于 2008-2-25 13:13:40

嘿墨菲
，我真的很感激这一点;我一直在取得进展，但进展非常缓慢。
这些东西不是很直观。
好的，我将代码复制到一个新模块中;我仍然收到一些错误。
我做的第一件事是注释掉你对Excel的任何引用;现在。
另一件事是，这个代码

copy

i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
     MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
     Exit Sub
End If

它告诉我，没有一个工作表集是打开的，而实际上它是打开的;所以我把它注释掉了。
我可能做错了什么，但我打开了图纸集管理器并加载了图纸集
，我正在使用CAD附带的示例（民用），并且其中一个布局打开并处于活动状态。
另外，我现在看到sUserName，sMachineName是数据库GetLockOwnerInfo方法的一部分。
这样，我不断收到错误，即工作表集被我锁定在我的机器上。
那么，我们是否过早地锁定了图纸集？
另外，我们是否缺少一个函数：？
GetCSSProperties
再次感谢您为我分解代码;这使它更加全面。
我只是不完全确定为什么我们会犯这样的错误。
马克

Murph · 发表于 2008-2-26 06:24:09

标记，
GetCSSProperties应该包含在我链接的dvb中。
您能在设置i = SheetSetsOpen的地方停止代码并检查I的值吗？
您运行的是什么版本/风格的Autocad？
至于被锁定的纸张组，如果您一直使用相同的纸张组进行测试，则纸张组可能仍会在上次程序出错时被锁定。
查找并运行SheetSetSheet.unlockdbnow，然后运行我之前给你的东西。
让我知道接下来会发生什么。墨菲

片材套装中的自定义道具

发表回复

精选推荐