请问如何在已有图纸上选择一条直线？

fuit

在下是一个刚接触CAD的菜鸟，由于要做上百张图纸的重复修改（就是移动一根线）想编一个宏，但看了VBA的书后又不甚解，还望各位指点。问题是这样的，图纸上一个矩形其中右面的那条边需要往X正轴方向移9，然后底下那根线再延长，与之相连。谢谢各位！

mccad

把你的图贴一部分出来看看需要调整的部分。
如果手工选择好编程。自动选择则需要很多条件，如线的性质、长度等信息(也就是说需要使用过滤器过滤出所需要的图元，而且过滤出的图元是唯一的)。

fuit

是自动选择，以下是我实现的代码：
Public Mydrawing As AcadApplication
Private Sub Command1_Click()
Dim i As Integer
Dim n As Integer
Dim Path_file() As String
Dim Text_temp As String
Dim ssetObj As AcadSelectionSet
Dim m As Integer
Dim Mode As Integer
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
Dim entObj As AcadEntity
Dim lineobj As AcadLine
Set Mydrawing = autocad.Application
Ismydrawopen = True


    If Mydrawing.ActiveDocument.SelectionSets.Count <> 0 Then
        For m = 0 To Mydrawing.ActiveDocument.SelectionSets.Count - 1
            Set ssetObj = Mydrawing.ActiveDocument.SelectionSets.Item(m)
            ssetObj.Delete
        Next m
    End If
    Set ssetObj = Mydrawing.ActiveDocument.SelectionSets.Add("lineselect")
    Mode = acSelectionSetCrossing
    corner1(0) = 105: corner1(1) = 286: corner1(2) = 0
    corner2(0) = 96: corner2(1) = 290: corner2(2) = 0
    ssetObj.Select Mode, corner1, corner2
    a = ssetObj.Count
   
    corner1(0) = 100: corner1(1) = 286: corner1(2) = 0
    corner2(0) = 109: corner2(1) = 286: corner2(2) = 0
    Set entObj = ssetObj.Item(0)
    entObj.Move corner1, corner2
   
    Set ssetObj = Mydrawing.ActiveDocument.SelectionSets.Add("lineselect1")
    Mode = acSelectionSetCrossing
    corner1(0) = 45: corner1(1) = 285: corner1(2) = 0
    corner2(0) = 47: corner2(1) = 282: corner2(2) = 0
    ssetObj.Select Mode, corner1, corner2
    corner1(0) = 25: corner1(1) = 284.34: corner1(2) = 0
    corner2(0) = 108.55: corner2(1) = 284.34: corner2(2) = 0
    Set lineobj = Mydrawing.ActiveDocument.PaperSpace.AddLine(corner1, corner2)
    lineobj.Linetype = ssetObj.Item(0).Linetype
    lineobj.Color = ssetObj.Item(0).Color
    lineobj.Layer = ssetObj.Item(0).Layer
    ssetObj.Item(0).Delete
    entObj.Update
    Mydrawing.ActiveDocument.Save
以上代码是在VB下的，CAD的VBA中只要将mydrawing.activedocument改成thisdrawing就行执行。但现在有两个问题，
1）我将代码在VBA中运行可以通过并且正确执行了。但是在VB下就选不到那些线。（线的位置在图纸上是固定的。）
2）我不知道lineobj.Linetype = ssetObj.Item(0).Linetype
    lineobj.Color = ssetObj.Item(0).Color
    lineobj.Layer = ssetObj.Item(0).Layer
这些代码是不是就能使后加的线与原先的线性质一样，至少打印出来后看不区别？
（原先想把原来的线延长的，可是不会写代码，参考书上也没找到相关内容）
还望各位帮助，指教。谢谢！

mccad

1.我这里VB没有装，你试试先击话某个图形文件(即先将某个图形文件设为当前)。
2.如果你的对象都是使用图层中的属性做为对象属性，则你这样做应该是正确的。
3.对象的延伸确实是个难题，在你这个问题中，你可以修改原先直线的两个端点的坐标来达到你的目的。
4.你程序中对于选择集的构造复杂了点，你可以看看实用函数栏目中相关选择集方面的函数，有一个是直接构造一个空选择集。

fuit

现在有问题，就是在VBA下能选到的线，放到VB中就选不到呢？
VBA：
Set ssetObj = ThisDrawing.SelectionSets.Add("TESTSET1")
Dim Mode As Integer
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
Mode = acSelectionSetCrossing
corner1(0) = 98: corner1(1) = 286: corner1(2) = 0
corner2(0) = 101: corner2(1) = 290: corner2(2) = 0
ssetObj.Select Mode, corner1, corner2
能选到。
VB：
    Set ssetObj = Mydrawing.ActiveDocument.SelectionSets.Add("aaaa")
    Mode = acSelectionSetCrossing
    corner1(0) = 98: corner1(1) = 286: corner1(2) = 0
    corner2(0) = 101: corner2(1) = 290: corner2(2) = 0
    ssetObj.Select Mode, corner2, corner1
就是选不到那根线。
还请指教。

mccad

如果只是为了改这些图纸的话，你可以直接在VBA中使用。
最理想的方法是，读取相应目录下的文件列表(需要一些象API类的函数才能解决)，逐一打开文件进行修改，然后关闭。
注意你的VBA宏可以加载到一个空的图形中运行，因为ACAD现在支持多文档界面，所以你可以用当前的宏去操作其它图形。

南子

fuit

今天在我反复的调试下发现,如果打开的图纸时,所要选的内空没显示在屏幕上的话是不能选中的.正想上来跟大家分享时，楼上南哥已经提醒我了。呵呵。谢谢大家，谢谢版主！

fuit

今天总算发现问题的所在了要加一句zoom all。谢谢mccad大哥的对我耐心的指点。我用VB其实就是为了，解决自动依次打开目录下所有图纸然后修改，保存，关闭。API也能用在VBA中是的吗？我去学学。谢谢大家！三千多张图纸要在喝荼，看报中灰飞烟灭了。