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

fuit · 发表于 2002-7-22 16:59:00

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

mccad · 发表于 2002-7-22 21:05:00

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

fuit · 发表于 2002-7-24 14:38:00

是自动选择，以下是我实现的代码：
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 · 发表于 2002-7-24 20:05:00

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

fuit · 发表于 2002-7-25 15:14:00

现在有问题，就是在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
就是选不到那根线。
还请指教。