提取图中属性到外部文件

marting · 发表于 2017-5-6 19:29:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(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)
)

(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

sh_h · 发表于 2017-5-7 20:58:15

哇，简直酷毙了！！！

kqqt6236 · 发表于 2017-5-8 00:06:08

谢谢分享。

账号		自动登录	找回密码
密码			立即注册

[每日一码] 提取图中属性到外部文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。