[求助]

wangyancai

Sub addline1()
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double
pt1(0) = 1000: pt1(1) = 1000: pt1(2) = 0
pt2(0) = 1200: pt1(1) = 1000: pt1(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
End Sub
Sub rotateline()
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double
pt1(0) = 1000: pt1(1) = 1000: pt1(2) = 0
pt2(0) = 1200: pt1(1) = 1000: pt1(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(pt1, pt2)
ZoomAll
Dim basepoint(0 To 2) As Double
Dim rotationangle As Double
dim angle as double
basepoint(0) = pt1(0): basepoint(1) = pt1(1): basepoint(2) = pt1(2)
rotationangle = ThisDrawing.Utility.GetAngle(, "指定角度")
Angle = Angle *3.1415926/180
tbangle = Round(angle, 2)
rotationangle=tbangle
linobj.Rotate basepoint, rotationangle
lineobj.Update
End Sub

wyj7485

'Angle = Angle *3.1415926/180
'tbangle = Round(angle, 2)
'rotationangle=tbangle'上面3句不要啊!
'linobj.Rotate basepoint, rotationangle'此句linobj与前不一致啊!应该为lineobj

wangyancai

此程序运行不出来 急盼高手指点，要不然毕不了业了，救命呀 Public Function getpoint(pt As Variant, x As Double, y As Double) As Variant
Dim pttarget(0 To 2) As Double
pttarget(0) = pt(0) + x: pttarget(1) = pt(1) + y: pttarget(2) = 0
getpoint = pttarget
Public Sub Testline()
Dim d1, d3, R1 As Double
Dim p1 As Variant
Dim p2, p3, p4, p5 As Variant
Dim ln1, ln2, ln3, ln4 As AcadLine
d1 = 15
R1 = 9
d3 = 4.1
p1(0) = 100: p1(1) = 100: p1(2) = 0
p2 = getpoint(p1, 0, d1 / 2)
p3 = getpoint(p1, 0, R1 - 0.5 - d3 / 2)
p4 = getpoint(p3, 0.5, 0.5)
p5 = getpoint(pt4, 0, d3)
Set ln1 = ThisDrawing.ModelSpace.addline(p1, p2)
Set ln2 = ThisDrawing.ModelSpace.addline(p2, p3)
Set ln3 = ThisDrawing.ModelSpace.addline(p3, p4)
Set ln4 = ThisDrawing.ModelSpace.addline(p4, p5)
End Sub

雪山飞狐_lzh

Dim ln1, ln2, ln3, ln4 As AcadLine VB里没有这种写法，如果这么写表示ln1, ln2, ln3是变体，ln4 是AcadLine Public Sub Testline()
Dim d1 As Double, d3 As Double, R1 As Double
Dim p1(2) As Double
Dim p2, p3, p4, p5
Dim ln1 As AcadLine, ln2 As AcadLine, ln3 As AcadLine, ln4 As AcadLine
d1 = 15
R1 = 9
d3 = 4.1
p1(0) = 100: p1(1) = 100: p1(2) = 0
p2 = getpoint(p1, 0#, d1 / 2)
p3 = getpoint(p1, 0#, R1 - 0.5 - d3 / 2)
p4 = getpoint(p3, 0.5, 0.5)
p5 = getpoint(p4, 0#, d3)
Set ln1 = ThisDrawing.ModelSpace.AddLine(p1, p2)
Set ln2 = ThisDrawing.ModelSpace.AddLine(p2, p3)
Set ln3 = ThisDrawing.ModelSpace.AddLine(p3, p4)
Set ln4 = ThisDrawing.ModelSpace.AddLine(p4, p5)
End Sub

wangyancai

Sub offsetline()
Dim lineobj As AcadLine
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
p1(0) = 50: p1(1) = 50: p1(2) = 0
p2(0) = 60: p2(1) = 60: p2(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(p1, p2)
lineobj.Closed = True
ZoomAll
Dim offsetobj As Variant
offsetobj = lineobj1.Offset(0.25)
End Sub

zyh0312

Sub offsetline()
Dim lineobj As AcadLine
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
p1(0) = 50: p1(1) = 50: p1(2) = 0
p2(0) = 60: p2(1) = 60: p2(2) = 0
Set lineobj = ThisDrawing.ModelSpace.AddLine(p1, p2)
'去除该行lineobj.Closed = True
ZoomAll
Dim offsetobj As Variant
offsetobj = lineobj.Offset(0.25) '该处原来为offsetobj 1= lineobj.Offset(0.25)

End Sub

wangyancai

Sub lengthenline()
Dim lineobj As AcadLine
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
p1(0) = 50: p1(1) = 50: p1(2) = 0
p2(0) = 60: p2(1) = 60: p2(2) = 0
setlineobj1 = ThisDrawing.ModelSpace.AddLine(p1, p2)
lineobj1.Update
Dim p3(0 To 2) As Double
Dim p4(0 To 2) As Double
p3(0) = 40: p3(1) = 80: p3(2) = 0
p4(0) = 100: p4(1) = 80: p4(2) = 0
Set lineobj2 = ThisDrawing.ModelSpace.AddLine(p3, p4)
lineobj1.EndPoint = lineobj2
lineobj1.Update
End Sub

wangyancai

Sub lengthenline()
Dim lineobj As AcadLine
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
p1(0) = 50: p1(1) = 50: p1(2) = 0
p2(0) = 60: p2(1) = 60: p2(2) = 0
setlineobj1 = ThisDrawing.ModelSpace.AddLine(p1, p2)
lineobj1.Update
Dim p3(0 To 2) As Double
Dim p4(0 To 2) As Double
p3(0) = 40: p3(1) = 80: p3(2) = 0
p4(0) = 100: p4(1) = 80: p4(2) = 0
Set lineobj2 = ThisDrawing.ModelSpace.AddLine(p3, p4)
lineobj1.EndPoint = lineobj2
lineobj1.Update
End Sub