Option Explicit
Public Sub DtlValUpdate()
Dim strDrawingName As String, vardata(1) As Variant, intType(1) As Integer, varAtts As Variant
Dim objSelSet As AcadSelectionSet, objBlockRefAs AcadBlockReference, i As Integer, objAttRef As AcadAttributeReference
strDrawingName = (Left(ThisDrawing.Name, (Len(ThisDrawing.Name) - 4)))
intType(0) = 0
vardata(0) = "INSERT"
intType(1) = 2
vardata(1) = "DT-IDLABEL"
ACADSelSet objSelSet, "UPDateDtl"
objSelSet.Select Mode:=acSelectionSetAll, FilterType:=intType, FilterData:=vardata
For Each objBlockRef In objSelSet
If objBlockRef.HasAttributes Then
varAtts = objBlockRef.GetAttributes
For i = LBound(varAtts) To UBound(varAtts)
Set objAttRef = varAtts(i)
If objAttRef.TagString = "DNO#" Then
objAttRef.TextString = strDrawingName
Exit For
End If
Next i
End If
Next objBlockRef
End Sub
Public Function ACADSelSet(funcObjSelSet As AcadSelectionSet, funcSelectionSetName As String)
Dim objSelCol As AcadSelectionSets
On Error GoTo Err_Control
Set objSelCol = ThisDrawing.SelectionSets
For Each funcObjSelSet In objSelCol
If funcObjSelSet.Name = funcSelectionSetName Then
funcObjSelSet.Clear
funcObjSelSet.Delete
Exit For
End If
Next
Set funcObjSelSet = objSelCol.Add(funcSelectionSetName)
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
Case -2145386300
MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
Case Else
MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
End Select
End Function
你好
谢谢你的代码。
此代码逻辑颠倒，员工需要。
属性值，将生成dwg文件名
我正在努力，但我做不到
这可能吗？
谢谢
页:
1
[2]