[求助]用VBA读实体的组码

lihengmin

怎样用VBA读实体的组码?如下面的数据内读出“图元名: 43f47cc0”

((-1 . <图元名: 43fd1a58>) (0 . "INSERT") (5 . "33A8B") (102 . "{ACAD_REACTORS") (330 . <图元名: 43fd1a30>) (102 . }") (330 . <图元名: 43f47cc0>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "ZBTZ") (6 . "Continuous") (100 . "AcDbBlockReference") (2 . "gc429") (10 517405.0 4.08063e+006 0.0) (41 . 3.0) (42 . 3.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))

lihengmin

求助
怎么用VBA读取CAD实体的DXF组码？如编组的组码
((-1 . <图元名: 43fd1a48>) (0 . "INSERT") (5 . "33A89") (102 . "{ACAD_REACTORS") (330 . <图元名: 43fd1a30>) (102 . "}") (330 . <图元名: 43f47cc0>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "ZBTZ") (6 . "Continuous") (100 . "AcDbBlockReference") (2 . "gc429") (10 517285.0 4.08063e+006 0.0) (41 . 3.0) (42 . 3.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
上面的数据内怎么读出(330 . <图元名: 43f47cc0>)

robbin840311

明月，我也发帖了，没有人回啊

xxxtttxxx

如果cad对象参考中没有这个函数，那么估计是没有直接的办法了。

像我在另外一贴回的那样，可以试试：

没有试过读取组码。

而且感觉组码这个东西比较复杂，不同地方含义有不相同。

实体的祖码我不会，不过我觉得可以自己在帮助中查到实体组码，然后与其对应

的entitytype列表，vba查询到实体的entitytype，对应找到组码

mccad

可能有两个方法：
1.使用VLAX类。
2.将图转成DXF，以处理文本的方法来处理。

robbin840311

请问使用VLAX 怎么使用？VLAX类代码如下：

Private VL As Object
Private VLF As Object
Private Sub Class_Initialize()
     If Left(ThisDrawing.Application.Version, 2) = "15" Then
      Set VL = GetInterfaceObject("VL.Application.1")
     ElseIf Left(ThisDrawing.Application.Version, 2) = "16" Then
      Set VL = GetInterfaceObject("VL.Application.16")
     ElseIf Left(ThisDrawing.Application.Version, 2) = "17" Then
      Set VL = GetInterfaceObject("VL.Application.16")
     End If
     Set VLF = VL.ActiveDocument.Functions
End Sub
Private Sub Class_Terminate()
     Set VLF = Nothing
     Set VL = Nothing
End Sub
Public Function EvalLispExpression(ByVal lispStatement As String)
     Dim sym As Object, RET As Object, RetVal
    
     Set sym = VLF.Item("read").Funcall(lispStatement)
     On Error Resume Next
     RetVal = VLF.Item("eval").Funcall(sym)
     If Err Then
         EvalLispExpression = ""
     Else
         EvalLispExpression = RetVal
     End If
End Function
Public Sub SetLispSymbol(ByVal symbolName As String, ByVal Value)
     Dim sym As Object, RET, symvalue
    
     symvalue = Value
     Set sym = VLF.Item("read").Funcall(symbolName)
     RET = VLF.Item("set").Funcall(sym, symvalue)
     EvalLispExpression "(defun translate-variant (data) (cond ((= (type data) 'list) (mapcar 'translate-variant data)) ((= (type data) 'variant) (translate-variant (vlax-variant-value data))) ((= (type data) 'safearray) (mapcar 'translate-variant (vlax-safearray->list data))) (t data)))"
     EvalLispExpression "(setq " & symbolName & "(translate-variant " & symbolName & "))"
     EvalLispExpression "(setq translate-variant nil)"
End Sub
Public Function GetLispSymbol(ByVal symbolName As String)
     Dim sym As Object, RET, symvalue
    
     symvalue = Value
     Set sym = VLF.Item("read").Funcall(symbolName)
     GetLispSymbol = VLF.Item("eval").Funcall(sym)
End Function
Public Function GetLispList(ByVal symbolName As String) As Variant
    Dim sym As Object, list As Object
    Dim Count, elements(), i As Long
   
    Set sym = VLF.Item("Read").Funcall(symbolName)
    Set list = VLF.Item("Eval").Funcall(sym)
   
    Count = VLF.Item("length").Funcall(list)
   
    ReDim elements(0 To Count - 1) As Variant
   
    For i = 0 To Count - 1
         elements(i) = VLF.Item("nth").Funcall(i, list)
    Next
   
    GetLispList = elements
   
End Function
Public Sub NullifySymbol(ParamArray symbolName())
     Dim i As Integer
    
     For i = LBound(symbolName) To UBound(symbolName)
         EvalLispExpression "(setq " & CStr(symbolName(i)) & " nil)"
     Next
End Sub

lihengmin

麻烦您指教 使用VLAX类怎样读取,是上面的VLAX类吗?怎样调用

十分感谢

robbin840311

请版主回答啊

lihengmin

帮帮忙吧

lihengmin

 (assoc 331 (car (entsel)))

用此命令可得到 “ (330 . <图元名: 43fd1a30>) ”，但有时得到前面330  有的实体得到后面的，是怎么搞的？