获取 Xrecord 数据（第 2 课）

T.Willey · 发表于 2006-7-18 13:24:20

这是我的代码

Public Function GetXRecLisp() As AcadXRecord
Dim DictCol As AcadDictionaries
Dim MyDict As AcadDictionary
Dim XRec As AcadXRecord
Set DictCol = ThisDrawing.Dictionaries
On Error GoTo MyError
Set MyDict = DictCol.Item("LisptoVBA")
Set XRec = MyDict.Item("LisptoVBA")
Set GetXRecLisp = XRec
Exit Function
MyError:
    MsgBox "Error " & Err.Number & " ( " & Err.Description & " )"
    
End Function
Public Sub ShowXrecData(ByRef XRec As AcadXRecord)
Dim DataType As Integer
Dim Data As Variant
Dim Cnt As Integer
Set XRec = GetXRecLisp
XRec.GetXRecordData DataType, Data
For Cnt = 0 To UBound(Data)
    MsgBox Data(Cnt)
Next
End Sub

第一个似乎有效。我尝试了两个图形，一个有信息，没有错误消息提示，一个没有信息，得到了错误消息。我的问题似乎是第二个代码。我试图看看是否可以在不指定大小的情况下获取xrecord数据，并将其打印到消息框中（目前命令行也可以）
这是用于添加xrecord和dictionary的lisp代码（以防万一）。

copy

(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.
(vla-SetXRecordData Obj
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbInteger
    (cons 0 (1- (length CodeList)))
   )
   CodeList
  )
 )
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbVariant
    (cons 0 (1- (length Datalist)))
   )
   DataList
  )
 )
)
)
(MySetXrec
 (vla-AddXRecord
  (vla-Add
   (vla-get-Dictionaries
    (vla-get-ActiveDocument
     (vlax-get-Acad-Object)
    )
   )
   "LisptoVBA"
  )
  "LisptoVBA"
 )
 '(1 2)
 '("Testing" "Again")
)

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

T.Willey · 发表于 2006-7-18 13:37:24

未经测试的
但这是我如何灵活地编写GetXRecLisp的方法-

copy

Public Function GetXRecLisp(dictname As String, _
                            xrecname As String) _
                            As AcadXRecord
    Dim dict As AcadDictionary, _
        xrec As AcadXRecord
    
    On Error GoTo GetXRecLispError
    Set dict = ThisDrawing.Dictionaries.Item(dictname)
    Set xrec = dict.Item(xrecname)
    Set GetXRecLisp = xrec
    Exit Function
    
GetXRecLispError:
    Err.Clear
    Set GetXRecLisp = Nothing
    ''  caller tests for nothing result
End Function

还要注意变量/标签命名(案例/特殊性等)。永久属于您的

Jeff_M · 发表于 2006-7-18 13:46:43

谢谢你迈克尔。当我明白自己在做什么的时候，我会考虑编码的灵活性。我一如既往地喜欢你的表演。
What应该全部是小写字母是什么意思？这是VBA喜欢的吗？

T.Willey · 发表于 2006-7-18 13:51:39

我尝试/倾向于编码-
subs/函数：大写大小写，然后是骆驼大小写，例如GetThings Value
局部变量：小写，然后是骆驼大小写，例如独角主
模块/（类）成员变量：以my为前缀，然后与subs相同，例如myCollection
小部件：以缩写为前缀。小部件类型，然后作为子，例如frmMain。
大话题，但是对不起，我要去参加午餐会议，再见！

Jeff_M · 发表于 2006-7-18 14:08:08

copy

Public Sub ShowXrecData(ByRef Xrec As AcadXRecord)
Dim DataType As Variant
Dim Data As Variant
Dim Cnt As Integer
Set Xrec = GetXRecLisp
Xrec.GetXRecordData DataType, Data
For Cnt = 0 To UBound(Data)
    Debug.Print Data(Cnt)
Next
End Sub

所以我把我的代码改成了上面的样子。如何让它运行以便我可以测试它？我点击了播放按钮，但它要求一个宏名称。这似乎是因为它是用参数定义的。当我试图把它放进一个没有参数的潜艇里，并调用它时，它不起作用。
谢谢杰夫。

T.Willey · 发表于 2006-7-18 14:24:01

当您调用这个sub时，需要向它传递一个xrecord。另一个选择是去掉“ByRef Xrec As AcadXRecord ”,并在此sub中将其变暗。如果您这样做，您将不得不在dictionary集合中搜寻字典，然后通过字典找到xrecord。

T.Willey · 发表于 2006-7-18 14:31:55

Bob 说了什么，但是由于您在代码中获取了它，因此不需要将其作为参数传递。这是从您的其他线程的代码中继承而来的：

copy

Public Function GetXRecLisp() As AcadXRecord
Dim DictCol As AcadDictionaries
Dim MyDict As AcadDictionary
Dim XRec As AcadXRecord
Set DictCol = ThisDrawing.Dictionaries
On Error GoTo MyError
Set MyDict = DictCol.Item("VBAtoLisp")
Set XRec = MyDict.Item("VBAtoLisp")
Set GetXRecLisp = XRec
Exit Function
MyError:
    MsgBox "Error " & Err.Number & " ( " & Err.Description & " )"
    
End Function
Public Sub ShowXrecData()
Dim DataType As Variant
Dim Data As Variant
Dim Cnt As Integer
Dim XRec As AcadXRecord
Set XRec = GetXRecLisp
XRec.GetXRecordData DataType, Data
For Cnt = 0 To UBound(Data)
    MsgBox Data(Cnt)
Next
End Sub
Sub test2()
ShowXrecData
End Sub

T.Willey · 发表于 2006-7-18 14:33:35

谢谢你们，三个人。它现在正在工作。不知道我把它放在那里了。一定是在工作日早上试图编码到早期。

T.Willey · 发表于 2006-7-18 14:39:58

你不知道我花了多长时间才最终发现该怎么做。搜索这里，和帮助文件，但我现在有它，所以一切都很好。该吃午饭了。

获取 Xrecord 数据（第 2 课）

发表回复

精选推荐