马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
- (defun gattex ()
- (setq Blocklist '("Test Blockatt")) ; ** edit to include block names to
- ; select
- (setq TagList '("TAG1")) ; ** edit to include tag names to
- ; extract
- ; create block names separated by
- ; columns, for selection filter
- (setq Blocknames (List2String BlockList))
- (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
- (if (not ss)
- (quit)
- )
- (setq Root (getvar "DWGPREFIX"))
- (setq file (open (strcat Root (substr (getvar "DWGNAME") 1 (-
- (strlen
- (getvar "DWGNAME")
- ) 4
- )
- ) "attributes.CSV"
- ) "w"
- )
- i -1
- )
- (write-line (strcat Root (getvar "DWGNAME") " -found " (itoa
- (sslength ss)
- )
- " block(s) with attributes"
- ) file
- )
- (repeat (sslength ss)
- (setq TagRow nil
- ValRow nil
- )
- (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
- (write-line "" file)
- (write-line (strcat "block name:" "," (Dxf 2 Edata)) file)
- (while (/= (Dxf 0 Edata) "SEQEND")
- (if (and
- (= (Dxf 0 Edata) "ATTRIB")
- (member (dxf 2 Edata) TagList) ; if tag is on list
- ) ; and
- (progn
- (setq TagRow (cons (Dxf 2 Edata) TagRow))
- (setq valRow (cons (Dxf 1 Edata) ValRow))
- ) ; progn
- )
- (setq Edata (entget (setq e (entnext e))))
- ) ; while
- (write-line (List2String (reverse TagRow)) file)
- (write-line (List2String (reverse ValRow)) file)
- ) ; repeat
- (close file)
- (princ (strcat "\nDone writing file " Root "attributes.csv"))
- (princ)
- )
- ;defun
- ;;-------------------------------
- (defun List2String (Alist)
- (setq NumStr (length Alist))
- (foreach Item AList
- (if (= Item (car AList)) ; first item
- (setq LongString (car AList))
- (setq LongString (strcat LongString "," Item))
- )
- )
- LongString
- )
- ;defun
- ;;--------------------------------
- (defun Dxf (code pairs)
- (cdr (assoc code pairs))
- )
- (defun c:test ()
- (gattex)
- (princ)
- )
下面是VBA代码
[Visual Basic .NET] 纯文本查看 复制代码 Sub Blocks(row, col)
Dim BlocksSelSet As AcadSelectionSet
Dim blockref As AcadBlockReference
Dim AttRef As Variant
Dim I As Integer
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim groupCode As Variant, dataCode As Variant
Dim NumOfBlocks As Integer
Dim mode
Dim AttMode As Long
Dim constant As String
Dim currentmode As Integer
Dim attrobject As AcadAttribute
On Error Resume Next
Set BlocksSelSet = ThisDrawing.SelectionSets.Add("All_Blocks")
'define type of selection set (crossing, window, etc, in this case, all)
mode = acSelectionSetAll
'this is a selection set filter
gpCode(0) = 0
dataValue(0) = "Insert"
groupCode = gpCode
dataCode = dataValue
'this collects all blocks into the seletion set
BlocksSelSet.Select mode, , , groupCode, dataCode
NumOfBlocks = BlocksSelSet.Count
For x = 1 To NumOfBlocks
Set blockref = BlocksSelSet(x)
excelsheet.Cells(row, col).Value = blockref.Name
excelsheet.Cells(row, col + 1).Value = blockref.layer
excelsheet.Cells(row, col + 2).Value = Format(blockref.insertionPoint(0), "##,##0.00") & "," & Format(blockref.insertionPoint(1), "##,##0.00")
row = row + 1
AttRef = blockref.GetAttributes
For I = LBound(AttRef) To UBound(AttRef)
Set attrobject = AttRef(I)
' Do something with the attribute refs here.
excelsheet.Cells(row, col).Value = AttRef(I).TagString
excelsheet.Cells(row, col + 1).Value = AttRef(I).layer
excelsheet.Cells(row, col + 3).Value = AttRef(I).TextString
constant = Choose(attrobject.mode, "acAttributeModeInvisible", "acAttributeModeConstant", "", "acAttributeModeVerify", "", "", "", "acAttributeModePreset")
row = row + 1
Next
Next
row = row + 1
'clean up
BlocksSelSet.Clear
BlocksSelSet.Delete
rownum = row
End Sub
|