[VBA][紧急求助]关于遍历多段线的问题！！！
各位大侠好！本人现有难题，请大家给予帮忙，在此多谢先！
我有很多2000的旧图，使用了参照的功能，
在旧版软件里面打印时，可以通过设置颜色来统一设置线宽，没有问题。
但是现在更新autocad版本到2006后，这个方法却不管用了，尽管设置了线宽，
但是，每次打印时，在参照块里面的多段线的线宽总是不正确，
导致打印出来的图形线宽粗细不一，非常难看。
现在，一直没有办法解决，
除了就是到每一个参照块里面把所有的多段线都打散（分解）了。
这是一个非常麻烦的工作，由于大量的图纸，这几乎就是不可行的方法了。
所以，本人在想，是否可以做个VBA程序，直接在图纸里面运行，
遍历图中的多段线和参照块，
自动将图纸中的多段线以及所有参照块中的多段线全部分解，这样就省事多了；
或者是否可以在文件目录中，放置编写好的一个小程序，不用打开CAD程序，
直接遍历文件夹中的文件，以及文件中的多段线，并分解，这样是为了避免操作参照块。
以上思路不知道是否可行，还请高人出来指点一二！
谢谢！
**** Hidden Message ***** 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
谢谢2楼的兄弟帮忙，给出了代码。
我想问一下，这个应该是不能对参考进行操作吧？
有些代码我还看不太懂
能实现在一个文件里面对所有的参照文件都进行操作啊？？ 还有，就是如果直接使用上面的代码，转而遍历文件夹中所有的*.DWG文件，然后在后台打开并运行宏代码操作。可是每次操作的文件高达2000，这样的话，系统能不能吃得消呢？？真是头疼哦～～
vba只能在cad环境下运行,不能在后台运行,要的话建议用vb写 块参照多的情况下，也没有多大的影响
最近我刚刚对块进行炸开的操作，用的是过滤器的办法
这样就可以按照楼主的要求做了
wyj7485
说的不错，我正在弄这个，是用VB来实现呢，呵呵
VBA在VB里面着实折腾不出来啊，
能不能提供点代码，以便研究研究啊？
小弟平时会用VB编写一些东西，CAD的vba不太懂，还请多多指教，
wyj7485还有楼上的兄弟chman，
多谢先，呵呵
网上，好像针对这方面的资料也不多，真头疼噢：（
显示找不到“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
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
MsgBox "运行结束！", vbOKOnly, "工程1！"
End Sub
页:
[1]