还是直线问题

cxf11991

问一个简单的问题


lineobj as acadline


lineobj1 as acadline


这样的程序可以实现吗：


lineobj1=thisdrawing.modelspace.addline         (lineobj.startpoint, pt)


就把两点连线然后赋直线给lineobj1,使lineobj1具有lineobj1.startpoint 和lineobj1.endpoint


如果不行，应该怎么做，特急，在线等

gzy

你为什么不自己试一下呢？

2. Sub test()
3. Dim p1(0 To 2) As Double, p2(0 To 2) As Double
4. p1(0) = 0
5. p1(1) = 0
6. p1(2) = 0
7. p2(0) = 100
8. p2(1) = 100
9. p2(2) = 0
10. Dim line1 As AcadLine
11. Set line1 = ThisDrawing.ModelSpace.AddLine(p1, p2)Dim pt(0 To 2) As Double
12. pt(0) = 100
13. pt(1) = 50
14. pt(2) = 0
15. Set line1 = ThisDrawing.ModelSpace.AddLine(line1.EndPoint, pt)
16. End Sub

Sub test() Dim p1(0 To 2) As Double, p2(0 To 2) As Double p1(0) = 0 p1(1) = 0 p1(2) = 0 p2(0) = 100 p2(1) = 100 p2(2) = 0 Dim line1 As AcadLine Set line1 = ThisDrawing.ModelSpace.AddLine(p1, p2)Dim pt(0 To 2) As Double pt(0) = 100 pt(1) = 50 pt(2) = 0 Set line1 = ThisDrawing.ModelSpace.AddLine(line1.EndPoint, pt) End Sub

cxf11991

我用过了，这个我知道的 我是在一点程序里运行的，老是在这一段停住了， lineobj1 as acadline For Each entobj3 In objselectionset1
For Each entobj4 In objselectionset4
Set lineobj = entobj3
pt = entobj3.IntersectWith(entobj4, acExtendNone) lineobj1 = ThisDrawing.ModelSpace.AddLine(lineobj.StartPoint, pt) 错误提示内容为：对象变量或with块变量未设置 在程序里我从没用过with块，你可以知道大概是哪里有问题吗？》

gzy

贴多一点代码给大家看看吧。

cxf11991

我做的是关于剪切线段的代码 比如说有4条直线成井字放置，长短都不一样， 我想把交点之间的线段都剪掉， 编了下面部分代码
flog = True
For Each entobj3 In objselectionset1
For Each entobj4 In objselectionset4
Set lineobj = entobj3
pt = entobj3.IntersectWith(entobj4, acExtendNone)
If flog = True Then
lineobj1 = ThisDrawing.ModelSpace.AddLine(lineobj.StartPoint, pt)
lineobj2 = ThisDrawing.ModelSpace.AddLine(lineobj.EndPoint, pt)
flog = False
Else
lineobj3 = ThisDrawing.ModelSpace.AddLine(lineobj.StartPoint, pt)
lineobj4 = ThisDrawing.ModelSpace.AddLine(lineobj.EndPoint, pt)

If Sqr((lineobj1.StartPoint(0) - lineobj1.EndPoint(0)) ^ 2 + (lineobj1.StartPoint(1) - lineobj1.EndPoint(1)) ^ 2) < Sqr((lineobj3.StartPoint(0) - lineobj3.EndPoint(0)) ^ 2 + (lineobj3.StartPoint(1) - lineobj3.EndPoint(1)) ^ 2) Then
lineobj3.Delete

Else: lineobj1.Delete
End If
If Sqr((lineobj2.StartPoint(0) - lineobj2.EndPoint(0)) ^ 2 + (lineobj2.StartPoint(1) - lineobj2.EndPoint(1)) ^ 2) < Sqr((lineobj4.StartPoint(0) - lineobj4.EndPoint(0)) ^ 2 + (lineobj4.StartPoint(1) - lineobj4.EndPoint(1)) ^ 2) Then
lineobj2.Delete
Else: lineobj4.Delete
End If
flog = True
End If
Next
entobj3.Delete
Next
其中objselectionset1为两条横放直线，objselectionset2为两条竖放直线

gzy

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=20823&replyID=20295&skin=1 这里efan2000不是给你了吗？不过长度差距突出的话有点问题。

cxf11991

每次运行到 lineobj1 = ThisDrawing.ModelSpace.AddLine(lineobj.StartPoint, pt)


的时候就会提示错误：对象变量或with块变量未设置


能不能帮我改一下程序，在线等

cxf11991

不知道删除已经addline的直线，用lineobj1.delet可以删除图里的直线吗


如果不能应该用什么方法删除图里的直线啊！我想先问这个

gzy

你一试不就知道了吗？你试试有无line1.Delete 这句话的运行结果

2. Sub test()
3. Dim p1(0 To 2) As Double, p2(0 To 2) As Double
4. p1(0) = 0
5. p1(1) = 0
6. p1(2) = 0
7. p2(0) = 100
8. p2(1) = 100
9. p2(2) = 0
10. Dim line1 As AcadLine
11. Set line1 = ThisDrawing.ModelSpace.AddLine(p1, p2)Dim pt(0 To 2) As Double
12. pt(0) = 100
13. pt(1) = 50
14. pt(2) = 0
15. Dim line2 As AcadLine
16. Set line2 = ThisDrawing.ModelSpace.AddLine(line1.EndPoint, pt)line1.Delete  '你试试有无这句话的运行结果End Sub

Sub test() Dim p1(0 To 2) As Double, p2(0 To 2) As Double p1(0) = 0 p1(1) = 0 p1(2) = 0 p2(0) = 100 p2(1) = 100 p2(2) = 0 Dim line1 As AcadLine Set line1 = ThisDrawing.ModelSpace.AddLine(p1, p2)Dim pt(0 To 2) As Double pt(0) = 100 pt(1) = 50 pt(2) = 0 Dim line2 As AcadLine Set line2 = ThisDrawing.ModelSpace.AddLine(line1.EndPoint, pt)line1.Delete  '你试试有无这句话的运行结果End Sub

mccad

关键是IntersectWith方法取得的结果是数组，而不是单纯的一个点。多看看帮助文件吧。