明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 782|回复: 3

VB.NET 按颜色显示图元,运行效率欠佳,请高手赐教

[复制链接]
发表于 2015-12-24 16:37 | 显示全部楼层 |阅读模式
不知道是算法欠佳,还是其他问题,同样是选择41张a1图中显示某几种颜色,此程序需10s,而msteel工具箱仅2s左右,请高手优化,谢谢。YXX ,按色显示,QXX,全部显示。
  1. <CommandMethod("YXX", CommandFlags.UsePickSet)> _
  2.     Public Sub YXX()
  3.         '' 获得当前文档和数据库   Get the current document and database
  4.         Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
  5.         Dim acCurDb As Database = acDoc.Database
  6.         Dim acLyrTblRec As LayerTableRecord
  7.         Dim acLyrTbl As LayerTable
  8.         On Error Resume Next
  9.         ''启动一个事务   Start a transaction
  10.         Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
  11.             'Dim ColorList As New List(Of String)
  12.             'Dim ColorList As New ArrayList
  13.             Dim ColorList As New List(Of String)
  14.             Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection()
  15.             If acSSPrompt.Status = PromptStatus.OK Then
  16.                 Dim acSSet As SelectionSet = acSSPrompt.Value
  17.                 For Each acSSObj As SelectedObject In acSSet
  18.                     If Not IsDBNull(acSSObj) Then
  19.                         Dim acEnt As Entity = acTrans.GetObject(acSSObj.ObjectId, OpenMode.ForWrite)
  20.                         If Not IsDBNull(acEnt) Then
  21.                             Dim acEntColor As String = acEnt.Color.ToString
  22.                             'MsgBox(acEntColor)
  23.                             If acEntColor = "BYLAYER" Then
  24.                                 acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, OpenMode.ForRead)
  25.                                 acLyrTblRec = acTrans.GetObject(acLyrTbl(acEnt.Layer), OpenMode.ForWrite)
  26.                                 acEntColor = acLyrTblRec.Color.ToString
  27.                                 'MsgBox(acEntColor)
  28.                             End If
  29.                             '去重
  30.                             If ColorList.Contains(acEntColor) = False Then
  31.                                 ColorList.Add(acEntColor)
  32.                             End If
  33.                         End If
  34.                     End If
  35.                 Next
  36.             End If

  37.             Dim acSSPrompt1 As PromptSelectionResult = acDoc.Editor.SelectAll()
  38.             If acSSPrompt1.Status = PromptStatus.OK Then
  39.                 Dim acSSet1 As SelectionSet = acSSPrompt1.Value
  40.                 For Each acSSObj1 As SelectedObject In acSSet1
  41.                     If Not IsDBNull(acSSObj1) Then
  42.                         Dim acEnt1 As Entity = acTrans.GetObject(acSSObj1.ObjectId, OpenMode.ForWrite)
  43.                         If Not IsDBNull(acEnt1) Then
  44.                             Dim acEnt1Color As String = acEnt1.Color.ToString
  45.                             'MsgBox(acEntColor)
  46.                             If acEnt1Color = "BYLAYER" Then
  47.                                 acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, OpenMode.ForRead)
  48.                                 acLyrTblRec = acTrans.GetObject(acLyrTbl(acEnt1.Layer), OpenMode.ForWrite)
  49.                                 acEnt1Color = acLyrTblRec.Color.ToString
  50.                                 'MsgBox(acEntColor)
  51.                             End If
  52.                             If ColorList.Contains(acEnt1Color) = True Then
  53.                                 acEnt1.Visible = True
  54.                             Else
  55.                                 acEnt1.Visible = False
  56.                             End If
  57.                         End If
  58.                     End If
  59.                 Next
  60.             End If
  61.             acTrans.Commit()
  62.         End Using
  63.     End Sub


  64. <CommandMethod("QXX")> _
  65.     Public Sub QXX()
  66.         '' 获得当前文档和数据库   Get the current document and database
  67.         Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
  68.         Dim acCurDb As Database = acDoc.Database
  69.         'On Error Resume Next
  70.         ''启动一个事务   Start a transaction
  71.         Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
  72.             Dim acSSPrompt1 As PromptSelectionResult = acDoc.Editor.SelectAll()
  73.             If acSSPrompt1.Status = PromptStatus.OK Then
  74.                 Dim acSSet1 As SelectionSet = acSSPrompt1.Value
  75.                 For Each acSSObj1 As SelectedObject In acSSet1
  76.                     If Not IsDBNull(acSSObj1) Then
  77.                         Dim acEnt1 As Entity = acTrans.GetObject(acSSObj1.ObjectId, OpenMode.ForWrite)
  78.                         acEnt1.Visible = True
  79.                     End If
  80.                 Next
  81.             End If
  82.             acTrans.Commit()
  83.         End Using
  84.     End Sub
发表于 2015-12-25 15:46 | 显示全部楼层
你的代码是全图选择图元
用过滤器要快些的
 楼主| 发表于 2015-12-25 23:52 | 显示全部楼层
雪山飞狐_lzh 发表于 2015-12-25 15:46
你的代码是全图选择图元
用过滤器要快些的

我的思路是:1.任选几个图元,取图元色彩集。2.遍历所有对象,取每个对象颜色,若在色彩集中则显示,反之关闭。
过滤器?通过色彩不太好选,不同层,不同色,颜色随层时,都是256(BYLAYER),选不中啊
.visible的对象不能是选择集。。所以遍历了所有图元判断.
发表于 2015-12-26 16:58 来自手机 | 显示全部楼层
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=75642最后一个帖子我贴了按线型过滤的例子 颜色过滤类似
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 21:12 , Processed in 0.259924 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表