线段vb脚本

Ⅰ VB编程 制作绘图软件 拖动鼠标左键画连续线,拖动右键画线段

Dim Oldx As Single
Dim Oldy As Single
Dim L As Boolean
Dim i As Integer
Private Sub Form_Load()
i = 0
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
i = i + 1
If i Mod 2 = 0 Then
Me.Line (Oldx, Oldy)-(X, Y)
Else
Oldx = X
Oldy = Y
Me.PSet (X, Y)
End If
Else
L = True
Oldx = X
Oldy = Y
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If L = True Then
Line (Oldx, Oldy)-(X, Y)
Oldx = X
Oldy = Y
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
L = False
End Sub

Ⅱ vb中 form load 如何设置装入线段

}
cluster.swap(TTemp);

for(int i=0;i<cluster.size();i++)
cout<<"大小 "<<cluster[i].num<<" 是否分配 "<<cluster[i].is_data<<endl;

}
}
return 0;
}

Ⅲ 怎样用VB制作一个线段围绕一点旋转

不明白，

试试这个

Dim run As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Const Pi As Double = 3.1415936
Private Sub Form_Load()
Dim x As Long, y As Long
Dim x1 As Long, y1 As Long
Dim x2 As Long, y2 As Long
x = 610
y = 610
x1 = 100: y1 = 200
x2 = 360: y2 = 140

Dim l1 As Double, l2 As Double, l3 As Double, a As Double, b As Double
l3 = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
l1 = Sqr((x - x1) ^ 2 + (y - y1) ^ 2)
l2 = Sqr((x - x2) ^ 2 + (y - y2) ^ 2)
a = IIf(y < y1, 1, -1) * Arccos((x - x1) / l1)
b = Arccos((l1 ^ 2 + l2 ^ 2 - l3 ^ 2) / (2 * l1 * l2))
run = True
Show
Do While run
Cls
a = a + (0.1 * 2 / Pi)
x1 = l1 * Cos(a) + x
y1 = l1 * Sin(a) + y
x2 = l2 * Cos(a + b) + x
y2 = l2 * Sin(a + b) + y
PSet (x, y)
Line (x1, y1)-(x2, y2)
Sleep 10
DoEvents
Loop
End Sub
Private Function Arccos(x As Double) As Double
If x = 1 Then
Arccos = 0
ElseIf x = -1 Then
Arccos = Pi
Else
Arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
run = False
End Sub

Ⅳ 谁能提供一段vb在CAD中绘制多段线的实例代码作参考！

多线段没画过，
线倒是画过，二话不说直接上代码你参考一下
绘制边框
Private Sub Command4_Click()
Set acadDoc = acadApp.ActiveDocument
link2
acadDoc.ActiveLayer = acadlay(0)
With adoRes
While Not .EOF
pt1(0) = !X: pt1(1) = !Y: pt1(2) = !z: pt2(0) = !X1: pt2(1) = !Y1: pt2(2) = !z1
draw pt1, pt2
.MoveNext
Wend
End With
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 20: pt2(1) = 10: pt2(2) = 0
draw pt1, pt2
'在坡
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 20: pt2(1) = 10: pt2(2) = 0
draw pt1, pt2
For c = 0 To 50 Step 10
pt1(0) = 0: pt1(1) = c: pt1(2) = 0
pt2(0) = 270: pt2(1) = c: pt2(2) = 0
draw pt1, pt2
Next c
pt1(0) = 20: pt1(1) = 0: pt1(2) = 0
pt2(0) = 20: pt2(1) = 190: pt2(2) = 0
draw pt1, pt2

pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 0: pt2(1) = -10: pt2(2) = 0
draw pt1, pt2

pt1(0) = 0: pt1(1) = -10: pt1(2) = 0
pt2(0) = 270: pt2(1) = -10: pt2(2) = 0
draw pt1, pt2
pt1(0) = 270: pt1(1) = -10: pt1(2) = 0
pt2(0) = 270: pt2(1) = 0: pt2(2) = 0
draw pt1, pt2
pt3(0) = 5: pt3(1) = -7
acadDoc.ModelSpace.AddText t, pt3, 4
pt3(0) = 55: pt3(1) = -7
acadDoc.ModelSpace.AddText t1, pt3, 4
a = 0
For c = 60 To 100 Step 10
pt1(0) = 20: pt1(1) = c: pt1(2) = 0
pt2(0) = 23: pt2(1) = c: pt2(2) = 0
draw pt1, pt2
pt1(0) = 10: pt1(1) = c - 1.6: pt1(2) = 0
acadDoc.ModelSpace.AddText a, pt1, 3.2
a = a + 2
Next c
'在图中加入地面高程
acadDoc.ActiveTextStyle = acadDoc.TextStyles.Add("楷体")
pt1(0) = 1: pt1(1) = 13: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("地面高程", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入设计高程
Call rote1(acadtext, pt1)
pt1(0) = 1: pt1(1) = 23: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("设计高程", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入填挖高
pt1(0) = 1: pt1(1) = 33: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("填 挖 高", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入坡度/坡长
pt1(0) = 0: pt1(1) = 5.5: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("坡 度", pt1, 3.2)
Call rote1(acadtext, pt1)
pt1(0) = 9: pt1(1) = 1: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("坡 长", pt1, 3.2)
Call rote1(acadtext, pt1)
'在图中加入桩号
pt1(0) = 1: pt1(1) = 43: pt1(2) = 0
Set acadtext = acadDoc.ModelSpace.AddText("桩 号", pt1, 3.2)
Call rote1(acadtext, pt1)
Call Command5_Click
End Sub
Private Sub draw(pt1, pt2)
Set AcadLine = acadDoc.ModelSpace.AddLine(pt1, pt2)
acadDoc.Regen acActiveViewport
End Sub
线倒是画过，二话不说直接上代码你参考一下