[VBA][紧急求助]关于遍历多段线的问题！！！

weinierxin · 发表于 2006-9-29 23:05:00

各位大侠好！

本人现有难题，请大家给予帮忙，在此多谢先！

我有很多AutoCAD2000的旧图，使用了参照的功能，

在旧版软件里面打印时，可以通过设置颜色来统一设置线宽，没有问题。

但是现在更新autocad版本到2006后，这个方法却不管用了，尽管设置了线宽，

但是，每次打印时，在参照块里面的多段线的线宽总是不正确，

导致打印出来的图形线宽粗细不一，非常难看。

现在，一直没有办法解决，

除了就是到每一个参照块里面把所有的多段线都打散（分解）了。

这是一个非常麻烦的工作，由于大量的图纸，这几乎就是不可行的方法了。

所以，本人在想，是否可以做个VBA程序，直接在图纸里面运行，

遍历图中的多段线和参照块，

自动将图纸中的多段线以及所有参照块中的多段线全部分解，这样就省事多了；

或者是否可以在文件目录中，放置编写好的一个小程序，不用打开CAD程序，

直接遍历文件夹中的文件，以及文件中的多段线，并分解，这样是为了避免操作参照块。

以上思路不知道是否可行，还请高人出来指点一二！

谢谢！

litsong@126.com

wyj7485 · 发表于 2006-9-30 09:37:00

Sub test()
On Error Resume Next

Dim MySet As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant

ThisDrawing.SelectionSets.Item("MySet ").Delete

FilterType(0) = 0: FilterData(0) = "LWPOLYLINE,INSERT"
Set MySet = ThisDrawing.SelectionSets.Add("MySet ")
MySet.Select acSelectionSetAll, , , FilterType, FilterData

Dim i As Integer

Dim Bobj As Object

For i = 0 To MySet.Count - 1
If MySet(i).ObjectName = "AcDbPolyline" Then
MySet(i).Explode
MySet(i).Delete
Else
    For Each Bobj In ThisDrawing.Blocks(MySet(i).Name)
    If Bobj.ObjectName = "AcDbPolyline" Then
    Bobj.Explode
    Bobj.Delete
    End If
    Next
End If
Next

End Sub

weinierxin · 发表于 2006-10-1 11:14:00

谢谢2楼的兄弟帮忙，给出了代码。

我想问一下，这个应该是不能对参考进行操作吧？

有些代码我还看不太懂

weinierxin · 发表于 2006-10-1 11:23:00

能实现在一个文件里面对所有的参照文件都进行操作啊？？

weinierxin · 发表于 2006-10-1 11:29:00

还有，就是如果直接使用上面的代码，转而遍历文件夹中所有的*.DWG文件，然后在后台打开并运行宏代码操作。可是每次操作的文件高达2000，这样的话，系统能不能吃得消呢？？真是头疼哦～～

wyj7485 · 发表于 2006-10-9 11:23:00

vba只能在cad环境下运行,不能在后台运行,要的话建议用vb写

chman · 发表于 2006-10-9 19:24:00

块参照多的情况下，也没有多大的影响

最近我刚刚对块进行炸开的操作，用的是过滤器的办法

这样就可以按照楼主的要求做了

weinierxin · 发表于 2006-10-11 22:18:00

wyj7485

说的不错，我正在弄这个，是用VB来实现呢，呵呵

VBA在VB里面着实折腾不出来啊，

能不能提供点代码，以便研究研究啊？

小弟平时会用VB编写一些东西，CAD的vba不太懂，还请多多指教，

wyj7485还有楼上的兄弟chman，

多谢先，呵呵

网上，好像针对这方面的资料也不多，真头疼噢：（

weinierxin · 发表于 2006-10-12 20:59:00

显示找不到“AcadSelectionSet”？？？

请帮忙分析一下下面的代码，谢谢先～～

Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object 'Application对象、Document对象、ModelSpace对象

Public Sub AutoCADOpen(FileName As String)        '打开AutoCAD子程序
On Error Resume Next
Set obj_Acad = GetObject(, "autocad.application") '若AutoCAD已启动,则直接得到Application对象,建议先打开CAD程序
If Err Then
   Err.Clear
   On Error Resume Next
   Set obj_Acad = CreateObject("autocad.application") '若AutoCAD未启动，则运行AutoCAD程序
   If Err Then
      Err.Clear
      MsgBox "不能运行AutoCAD,请检查是否安装！", vbOKOnly, "警告！"
      Exit Sub
      End If
End If
obj_Acad.Visible = True   '设置AutoCAD为可见（或者在后台运行,不可见）
obj_Acad.Documents.open (FileName) '打开AutoCAD图形文件
Set obj_Doc = obj_Acad.ActiveDocument '获得当前活动图形文件，即刚打开的图形文件
Set obj_ModelSpace = obj_Doc.ModelSpace '获得当前活动图形文件的模型空间

On Error Resume Next