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

litsong

各位大侠好！

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

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

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

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

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

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



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

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

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

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

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

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

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

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

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

谢谢！

litsong@126.com

zml84

对于CAD已经实现的功能，除非是学习之用，请不要在这上面浪费时间。
我是说，依旧按颜色打印即可。


你要是真的想做的话，咱们可以先分析以下
问题的关键是：
1、如何控制CAD依次打开这些图形；
2、对于每一个图形，2.1、遍历所有图元，若是参照块则打散；2.2、遍历所有图元，若是多段线则打散。
3、下一个图形。

litsong

谢谢楼上兄弟的提醒。
1、不过我现在使用的2006对于使用颜色控制的功能的确是弱了（不如2000），
关键是对参照图块内多段线的线宽不能控制，不知道zml84有没有试过，
而且我使用的参照不是一层，多的时候有3-4层的。
如果不是这样的问题，我当然不会自找麻烦这样折腾的。

2、我想遍历参照，但是不能打散参照。

3、思路有了，能不能给点代码。

zml84

我用的还是2004，06和07都太花梢了，跑起来感觉有点吃力。
使用参照的目的就是为了实现图纸的自动更新，为了打印将其打散是不是就达不到参照的目的了？

litsong

楼上还没有明白我的意思，我并不要打散参照！
而是打散参照中的多段线！
我想这样应该是不可行的，
所以，现在的想法就是，
遍历文件夹中存放的所有文件，对所有的多段线进行操作，
而不用对参照直接操作。
这样就从最底层将所有多段线全部打散，
从而参照中的多段线图形自然也是被打散的。呵呵

这个思路基本可行。
就是缺少代码，呵呵


还有，这个2006不是我想用，
是我们部门准备整体升级，没辄啊！！

zml84

1、对于查找参照图形，并打开参照图形的部分我尚未一代码实现过；
2、打开参照图形后，下面的工作是将多段线打散。模拟代码如下：

2. 
   
3.   [FONT=courier new]
   
4. ......
   
5. Dim MyObject As AcadEntity
   
6. For Each MyObject In ThisDrawing.ModelSpace               '在模型空间中遍历所有的图元
   
7.         If StrComp(MyObject.EntityName, "acdlwpolyline", 1) = 0 Then '这一句是判断对象是否是多段线
   
8.                 MyObject.explode
   
9.         End If '结束IF
   
10. Next MyObject '遍历下一个对象
    
11. ......
    
12.   [/FONT]
    

<br />   [FONT=courier new]<br /> ......<br /> Dim MyObject As AcadEntity<br /> For Each MyObject In ThisDrawing.ModelSpace               '在模型空间中遍历所有的图元<br />         If StrComp(MyObject.EntityName, "acdlwpolyline", 1) = 0 Then '这一句是判断对象是否是多段线<br />                 MyObject.explode<br />         End If '结束IF<br /> Next MyObject '遍历下一个对象<br /> ......<br />   [/FONT]<br />

litsong

我用VB来运行了，不过有问题噢。

找不到“AcadEntity”？？？




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 MyObject As AcadEntity
For Each MyObject In ThisDrawing.ModelSpace               '在模型空间中遍历所有的图元
        If StrComp(MyObject.EntityName, "acdlwpolyline", 1) = 0 Then '这一句是判断对象是否是多段线
                MyObject.explode
        End If '结束IF
Next MyObject '遍历下一个对象

MsgBox "运行结束！", vbOKOnly, "工程1！"
End Sub


Private Sub Command1_Click()
Dim FileName As String
CommonDialog1.CancelError = True   '点击文件对话框的“Cancel”时,就会产生错误
On Error GoTo ErrHandle
CommonDialog1.Filter = "*.dwg|*.dwg"  '设置文件对话框的文件类型
CommonDialog1.ShowOpen
FileName = CommonDialog1.FileName
Call AutoCADOpen(FileName)    '调用"打开AutoCAD子程序"
Exit Sub
ErrHandle:
Exit Sub
End Sub