片材套装中的自定义道具
嗨有人能够在图纸集中编辑自定义属性吗？
有CUSTOM_SHEET_PROP和CUSTOM_SHEET_PROP
CUSTOM_SHEET_PROP是特定于每张图纸(布局)的字段
CUSTOM _ SHEET _ PROP是所有图纸的字段
一个很好的例子是，在您的绘图总数中有1个#(例如)
嗯，您可以将1定义为CUSTOM _ SHEET _ PROP(字段),将#定义为CUSTOM _ SHEET _ PROP(字段),作为每张图纸(布局)的第一个数字更改，并将
因此，每次用户更新#(字段)时，布局将动态地重新索引。
一旦你开始掌握它的窍门；真的很酷。
无论如何，我们将项目数据写出到一个txt文件，通过属性，我们可以读入这些信息；现在，我需要能够这样做的领域(自定义_道具)
我已经取得了一些进展，很高兴分享我所拥有的，但我只是不能到最后一个拥挤。
任何帮助都将不胜感激。
谢谢！
Mark
PS:我在网上查过高低；vba示例等。
**** Hidden Message ***** 请给我发送一条私人消息，我将发布我的整套代码，以便在周一下班后完成所有这些工作。我使用我在博客上找到的信息（我也会发布该链接）为我们公司编写了整个界面。我们将信息导出到Excel中，以便非CAD人员可以对其进行编辑，并且还有一个导入例程。
它主要用于从不同办公室导入图纸集。
墨菲 马克，
附件是我从这个网站放在一起的东西：
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
墨菲
好吧，墨菲！
你的代码看起来很棒
当然，那里有很多需要的东西。
我只是希望能够首先编辑自定义道具，然后我肯定会更仔细地查看您发送的所有代码。
好吧，我现在将查看Utils函数
谢谢！
马克
我跳得有点快，但我刚刚注意到您正在使用脚本语言
这很酷；我也经常使用它
我注意到这是一些您正在获取用户名和机器的示例。
它在这里不起作用，但我没有起诉您是如何获取该信息的。
我一直使用脚本代码来检索该信息。
标记
嘿，Murph
再说一次，您的代码非常好，从中可以学到很多东西。
但是，它仍然有点复杂，因为所有的Excel工作都在进行中。
我正在寻找一个非常基本的例子，改变表和表中的自定义道具。
在我了解这一点后，我可以对其进行阐述。
你有没有稍微简单一点的？
谢谢！
标记 标记，
让我们一步一步地完成它，这样您就可以从中得到您想要的东西。
我们从SheetSetForm.SSStartHere.开始
这是检查您是否有一个工作表设置为打开状态，并确保只有一个是打开的。
它将锁定它，然后将其发送到Loop穿透SheetsPop
这是我们获取要呈现给用户以进行更改的值的地方。
请注意，GetCSSProperties正在发送一个字符串和一个工作表。该字符串是自定义工作表属性的EXACT Title。
您可以根据公司的自定义工作表属性自定义整个表单。
让我们假设某些值已更改并且用户点击OK按钮。该代码将我们发送到SetProps。
此例程检查一个且仅一个工作表集并锁定它。
因为这东西正在将工作表集的内容导出到Excel以在另一个办公室导入，所以我们现在将跳过它。
SetProps将我们发送到Loop穿透SheetsSet，它将执行此操作。
它将遍历所有工作表并将值设置为表单中的值。
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更改它。
标记，
插入一个新模块并将此代码粘贴到其中。
这将要求您更改属性标题，为您提供现有值并让您进行更改。
这是一个向您展示其余部分如何工作的示例。墨菲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
嘿墨菲
，我真的很感激这一点;我一直在取得进展，但进展非常缓慢。
这些东西不是很直观。
好的，我将代码复制到一个新模块中;我仍然收到一些错误。
我做的第一件事是注释掉你对Excel的任何引用;现在。
另一件事是，这个代码
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
再次感谢您为我分解代码;这使它更加全面。
我只是不完全确定为什么我们会犯这样的错误。
马克
标记，
GetCSSProperties应该包含在我链接的dvb中。
您能在设置i = SheetSetsOpen的地方停止代码并检查I的值吗？
您运行的是什么版本/风格的Autocad？
至于被锁定的纸张组，如果您一直使用相同的纸张组进行测试，则纸张组可能仍会在上次程序出错时被锁定。
查找并运行SheetSetSheet.unlockdbnow，然后运行我之前给你的东西。
让我知道接下来会发生什么。墨菲
页:
[1]
2