调用当前文件名，填写DWG 图形特性的自定义属性，可以做到吗？
本帖最后由 阡陌客 于 2015-5-15 21:56 编辑有没有一个宏可以做到：读取当前文件的文件名，填写到如下菜单看到的 图形特性的“自定义属性”
文件 >> 图形特性 >>自定义属性
比如：文件名为“TH15008-001 A 外壳.dwg” ，
执行宏或者LSP ，自动填写如下自定义属性
比如当前文件名为“TH15008-001 A 外壳.dwg”
自动获取文件名的前11个字符为图号，或者判断第一个空格之前的字符为图号。
第一个空格与第二个空格之间的字母为版本号A，
后面的字符为名称
因为3D软件 solidworks是可以用宏轻松实现，读取文件名，自动填写自定义属性，然后工程图调用属性值的。
不知道Acad能不能做到。已经搜了mjtd，没找到相关内容，恳请高手指点，谢谢！
附SW的宏
'从这里开始复制:
'定义solidwork
Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
'增加n个新变量
Dim cailiao As String
Dim banben As String
Dim mingcheng As String
Sub main()
'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '文件名
'cailiao = swApp.ActiveDoc.GetMaterial()
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34) '获取材料表达式
'定义各自定义属性
blnretval = Part.DeleteCustomInfo2("", "文件名")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "版本")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "设计")
blnretval = Part.DeleteCustomInfo2("", "审核")
blnretval = Part.DeleteCustomInfo2("", "工艺")
'blnretval = Part.DeleteCustomInfo2("", "材料")
'blnretval = Part.DeleteCustomInfo2("", "表面处理")
a = InStr(c, " ") - 1 '重点：分隔标识符，这里是一个空格
If a > 0 Then
k = Left(c, a)
t = Left(LTrim(e), 3)
If t = "GBT" Then
e = "GB/T" + Mid(k, 4)
Else
e = k
End If '以上取图号完成
b = Mid(c, a + 2) '得到（版本+名称+后缀名）
t = Right(c, 7) '取后缀名，并进行判断
If t = ".SLDPRT" Or t = ".SLDASM" Then
j = Len(b) - 7
Else
j = Len(b)
End If
m = Left(b, j)
banben = Left(m, 1)
mingcheng = Mid(m, 3)
End If
blnretval = Part.AddCustomInfo3("", "文件名", swCustomInfoText, c)'文件名
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)'代号
blnretval = Part.AddCustomInfo3("", "版本", swCustomInfoText, banben)'版本
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, mingcheng)'名称
blnretval = Part.AddCustomInfo3("", "设计", swCustomInfoText, " ") '填写设计者名字
blnretval = Part.AddCustomInfo3("", "审核", swCustomInfoText, " ")'填写审核人名字
blnretval = Part.AddCustomInfo3("", "工艺", swCustomInfoText, " ") '填写工艺人名字
'blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
'blnretval = Part.AddCustomInfo3("", "表面处理", swCustomInfoText, " ")
End Sub
文件 >> 图形特性 >>自定义属性 (setq doc (vla-get-activeDocument (vlax-get-acad-object)))
(setq info (vla-get-SummaryInfo doc))
(vla-AddCustomInfo info "比例" "1:16")
;支持的方法:
; AddCustomInfo (2)
; GetCustomByIndex (3)
; GetCustomByKey (2)
; NumCustomInfo ()
; RemoveCustomByIndex (1)
; RemoveCustomByKey (1)
; SetCustomByIndex (3)
; SetCustomByKey (2) (defun c:tt ()
(setq dwgname (getvar 'dwgname)
n (VL-STRING-SEARCH "." dwgname)
dwgname (substr dwgname 1 n)
n (VL-STRING-SEARCH " " dwgname)
th (substr dwgname 1 n)
n (+ n 2)
dwgname (substr dwgname n)
n (VL-STRING-SEARCH " " dwgname)
bb (substr dwgname 1 n)
mc (substr dwgname (+ 2 n))
)
(setq SummaryInfo
(vla-get-SummaryInfo
(vla-get-ActiveDocument (vlax-get-acad-object))
)
) ;_ 获取SummaryInfo对象
(mapcar
'(lambda (key newVal)
(if (VL-CATCH-ALL-ERROR-P
(VL-CATCH-ALL-APPLY
'vla-GetCustomByKey
(list
SummaryInfo
key
'val
)
)
)
(VL-CATCH-ALL-APPLY
'vla-AddCustomInfo
(list
SummaryInfo
key
newVal
)
)
(VL-CATCH-ALL-APPLY
'vla-SetCustomByKey
(list
SummaryInfo
key
newVal
)
)
)
)
(list "图号" "版本" "名称")
(list th bb mc)
)
(princ)
) 楼上的斑竹 太厉害了，请允许我膜拜一下 我没找到怎么把 [未解决]红字 改成[已解决]的绿字的办法，请斑竹帮忙操作一下，感谢！ 谢谢老师分享 的确是非常厉害啊 第一次接触自定义属性这个概念。
主要用途是什么呢？
页:
[1]