|
|
后面会不停更新使用梦想控件中objectarx编程接口和Vba编程接口的例程代码，主要是一些常用功能的函数代码,
例程的代码的编译运行需要控件库才行，最新控件库下载连接:，技术交流QQ群:112199959
VC: 遍历当前块表记录中的所有实体，并修改颜色的代码
复制代码VB6代码，得到图纸空间中所有实体
[code]
'得到当前图纸空间中所有实体的代码演示
'当前的图纸空间
Dim curSpace8 As MxDrawXLib.MxDrawBlockTableRecord
Set curSpace8 = app.WorkingDatabase.CurrentSpace
' 对象，用于向命令行输入出字符串
Dim mxUtility8 As MxDrawXLib.MxDrawUtility
Set mxUtility8 = New MxDrawXLib.MxDrawUtility
'遍历器，用于遍历当前图纸空间中所有的实体
Dim iter As MxDrawXLib.MxDrawBlockTableRecordIterator
Set iter = curSpace8.NewIterator
Dim ptDim1 As MxDrawXLib.MxDrawPoint
Dim ptDim2 As MxDrawXLib.MxDrawPoint
If (iter Is Nothing) Then
Exit Sub
End If
'循环得到所有实体
Do While iter.Done = False
' 得到遍历器当前的实体
Dim ent8 As MxDrawXLib.MxDrawEntity
Set ent8 = iter.GetEntity()
If (ent8 Is Nothing) = False Then
If TypeOf ent8 Is MxDrawXLib.MxDrawText Then
'当前实体是个文字实体
Dim text8 As MxDrawXLib.MxDrawText
Set text8 = ent8
mxUtility8.Prompt Chr(13) + Chr(10) + text8.TextString
ElseIf TypeOf ent8 Is MxDrawXLib.MxDrawPolyline Then
'当前实体是一个多义线
Dim polyline As MxDrawXLib.MxDrawPolyline
Set polyline = ent8
mxUtility8.Prompt Chr(13) + Chr(10) + "发现Polyline曲线, 下面是它的坐标信息:"
'得到Polyline的端点坐标
Dim iNum As Long
iNum = 0
Do While iNum 复制代码
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 |
|
置顶卡
