怎样用vba实现批量实现寻找一批cad文件中的最大封闭区域并提取出来
<p>怎样用vba实现批量实现寻找一批cad文件中的最大封闭区域并提取出来？</p><p>我遇到一个问题、，现在有大量的设计图纸，我要把它们的最大封闭区域找出来，并存成另外一个文件，最大封闭区域使用线段或多线段画成的，</p><p>图中的还有好多辅助的文字，。。</p><p></p><p>谢谢、！</p><p></p> <p></p><p>上图中，上面的图形式设计好的cad图形，现在我要去掉一些辅助信息、，只得到下面的图形，并保存，怎么弄？谢谢，如果一个个删除，也可以，但是图很多，工作量太大了、！</p> <p>这也是我正在探讨的问题.</p><p>图纸源的问题</p><p>1、去掉辅助信息比较好解决，只循环实体线(line、pline)即可。</p><p>2、一百个制图的人就有一百个习惯，有的人画图比较规矩，封闭做的比较好，有的人则画图根本不封闭，这是用VBA编程的一个难点。</p> <p>那怎么办呢？</p><p>楼上，你说的第一点怎么实现，我还没做过，这几天再看，我想用vb做个程序，然后批量打开一个文件夹中的所有dwg文件内，然后寻找里面的标注，文字信息全部删除，然后再找出里面的最大封闭图形，或者最大面域，进行填充，可以实现吧3</p> <p>遍历cad文件中的所有对象怎么做呢？比如文件中的线条、文字、标注、圆、多义线等。。。</p><p> Dim acadapp As Object '建立Application对象<br/> Dim acaddoc As Object '建立Document对象<br/> Dim mospace As Object '建立Model Space 对象<br/> On Error Resume Next<br/> Set acadapp = GetObject("autocad.application") '若AutoCad已启动 , 则直接得到<br/> If Err Then<br/> Err.Clear<br/> Set acadapp = CreateObject("autocad.application") '若AutoCad未启动，则运行它<br/> If Err Then<br/> MsgBox Err.Description<br/> Exit Sub<br/> End If<br/> End If<br/> acadapp.Visible = True '使AutoCad可见<br/> Set acaddoc = acadapp.ActiveDocument '设acaddoc为当前图形文件<br/> Set mospace = acaddoc.ModelSpace '设mospace为当前图形文件的模型空间<br/> <br/> acadapp.Top = 100 '设置AutoCad窗口的位置<br/> acadapp.Left = 200<br/> acadapp.Height = 768 '调整AutoCad窗口的大小<br/> acadapp.Width = 1024<br/> acadapp.Caption = "my first application" '设置AutoCad窗口的<br/></p> 应该充分利用选择集 <p>搞定，删除我不要的，就可以</p><p> Dim ObjNum As Long<br/> Dim Center(0 To 2) As Double<br/> Dim magnification As Double<br/> Center(0) = 3: Center(1) = 3: Center(2) = 0<br/> magnification = 10<br/> acaddoc.Application.Documents.Open App.Path & "\sample.dwg"<br/> Set acaddoc = acadapp.ActiveDocument '设acaddoc为当前'图形文件<br/> Set MoSpace = acaddoc.ModelSpace<br/> Set paSpace = acaddoc.PaperSpace<br/> ObjNum = paSpace.Count<br/> ObjNum = MoSpace.Count<br/> For Each ent In MoSpace<br/> Debug.Print ent.entityname<br/> If ent.entityname <> "AcDbLine" Then<br/> ent.Delete<br/> ZoomCenter Center, magnification<br/> 'ent.Update<br/> End If<br/> Next<br/>End Sub</p><p>但是我怎么把刚打开的图形移动到我的坐标原点呢？</p> <p>这几天忙别的了，今天又看了一下，还是不行，也就是还是不能找到最大封闭图形，并填充/</p><p>那位知道，来指各着</p><p></p>
页:
[1]