标记，
让'；让我们一步一步地走一遍，这样你就能从中得到你想要的
我们从SheetSetForm.SSStartHere开始
这是检查是否有一个图纸集打开，并确保只有一个打开
它将锁定它，然后将其发送到LoopThroughSheetsPop。在这里，我们可以获得要呈现给用户的值，以便进行更改
请注意，GetCSSProperties正在发送一个字符串和一个工作表。字符串是自定义图纸特性的确切标题
您可以根据您的公司定制整个表单#039；s自定义图纸属性
让'；s假设一些值已更改，用户点击OK按钮。那个代码把我们送到了SetProps
此例行程序仅检查一个图纸集并将其锁定
因为这些东西正在将图纸集导出到Excel，以便在另一个办公室导入，我们现在将跳过它
SetProps将我们发送到LoopThroughSheetsSet，它将执行此操作
它将遍历所有表单，并将值设置为表单中的值。如果用户没有'；他们仍然得到#039；更新#039；但什么都不会改变
- 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
| 
置顶卡