折断线绘制
'********************************************************************************************
'折断线绘制***********************************************折断线绘制****************************
'
Sub DrawDDX()
On Error GoTo E:
Dim P1 As Variant, P2 As Variant
ThisDrawing.Utility.InitializeUserInput 1, ""
P1 = ThisDrawing.Utility.GetPoint(, "指定折断的第一点: ")
ThisDrawing.Utility.InitializeUserInput 1, ""
P2 = ThisDrawing.Utility.GetPoint(P1, "指定折断的第二点: ")
Dim XD As AcadLine
Set XD = ThisDrawing.ModelSpace.AddLine(P1, P2)
'计算中点坐标
Dim PO(2) As Double
PO(0) = (P1(0) + P2(0)) / 2: PO(1) = (P1(1) + P2(1)) / 2: PO(2) = (P1(2) + P2(2)) / 2
'计算其他点坐标
Dim P3(2) As Double, P4(2) As Double, P5(2) As Double, P6(2) As Double, P7(2) As Double, P8(2) As Double
Dim Pi As Double ' 圆周率
'Pi = 3.14159265358973
Pi = 4 * Atn(1) '计算圆周率,反正切直为1对应的是45度。
'圆的半径
Dim R As Double
R = XD.Length
P3(0) = PO(0) + Cos(XD.angle + Pi / 2 - 1 * Pi / 9) * 0.15 * R '90-20度
P3(1) = PO(1) + Sin(XD.angle + Pi / 2 - 1 * Pi / 9) * 0.15 * R
P3(2) = P1(2)
P4(0) = PO(0) + Cos(XD.angle + 3 * Pi / 2 - 1 * Pi / 9) * 0.15 * R '270-20度
P4(1) = PO(1) + Sin(XD.angle + 3 * Pi / 2 - 1 * Pi / 9) * 0.15 * R
P4(2) = P1(2)
P5(0) = PO(0) + Cos(XD.angle) * 0.1 * R
P5(1) = PO(1) + Sin(XD.angle) * 0.1 * R
P5(2) = P1(2)
P6(0) = PO(0) + Cos(XD.angle + Pi) * 0.1 * R
P6(1) = PO(1) + Sin(XD.angle + Pi) * 0.1 * R
P6(2) = P1(2)
P7(0) = PO(0) + Cos(XD.angle) * R * 0.7
P7(1) = PO(1) + Sin(XD.angle) * R * 0.7
P7(2) = P1(2)
P8(0) = PO(0) + Cos(XD.angle + Pi) * R * 0.7
P8(1) = PO(1) + Sin(XD.angle + Pi) * R * 0.7
P8(2) = P1(2)
XD.Delete
'二维多线段绘制
Dim DDX As AcadLWPolyline '三维多线段为AcadPolyline
Dim P(0 To 11) As Double '三维多线段数组必须是三的陪数,前三个为一个坐标。
P(0) = P8(0): P(1) = P8(1) '二维两个为一个坐标
P(2) = P6(0): P(3) = P6(1)
P(4) = P4(0): P(5) = P4(1)
P(6) = P3(0): P(7) = P3(1)
P(8) = P5(0): P(9) = P5(1)
P(10) = P7(0): P(11) = P7(1)
ThisDrawing.ModelSpace.AddLightWeightPolyline P '绘制二维多线段,三维多线段为AddPolyline
End
E:
End Sub
'******************************************************************************************
'折断线绘制***********************************************折断线绘制****************************
'
Sub DrawDDX()
On Error GoTo E:
Dim P1 As Variant, P2 As Variant
ThisDrawing.Utility.InitializeUserInput 1, ""
P1 = ThisDrawing.Utility.GetPoint(, "指定折断的第一点: ")
ThisDrawing.Utility.InitializeUserInput 1, ""
P2 = ThisDrawing.Utility.GetPoint(P1, "指定折断的第二点: ")
Dim XD As AcadLine
Set XD = ThisDrawing.ModelSpace.AddLine(P1, P2)
'计算中点坐标
Dim PO(2) As Double
PO(0) = (P1(0) + P2(0)) / 2: PO(1) = (P1(1) + P2(1)) / 2: PO(2) = (P1(2) + P2(2)) / 2
'计算其他点坐标
Dim P3(2) As Double, P4(2) As Double, P5(2) As Double, P6(2) As Double, P7(2) As Double, P8(2) As Double
Dim Pi As Double ' 圆周率
'Pi = 3.14159265358973
Pi = 4 * Atn(1) '计算圆周率,反正切直为1对应的是45度。
'圆的半径
Dim R As Double
R = XD.Length
P3(0) = PO(0) + Cos(XD.angle + Pi / 2 - 1 * Pi / 9) * 0.15 * R '90-20度
P3(1) = PO(1) + Sin(XD.angle + Pi / 2 - 1 * Pi / 9) * 0.15 * R
P3(2) = P1(2)
P4(0) = PO(0) + Cos(XD.angle + 3 * Pi / 2 - 1 * Pi / 9) * 0.15 * R '270-20度
P4(1) = PO(1) + Sin(XD.angle + 3 * Pi / 2 - 1 * Pi / 9) * 0.15 * R
P4(2) = P1(2)
P5(0) = PO(0) + Cos(XD.angle) * 0.1 * R
P5(1) = PO(1) + Sin(XD.angle) * 0.1 * R
P5(2) = P1(2)
P6(0) = PO(0) + Cos(XD.angle + Pi) * 0.1 * R
P6(1) = PO(1) + Sin(XD.angle + Pi) * 0.1 * R
P6(2) = P1(2)
P7(0) = PO(0) + Cos(XD.angle) * R * 0.7
P7(1) = PO(1) + Sin(XD.angle) * R * 0.7
P7(2) = P1(2)
P8(0) = PO(0) + Cos(XD.angle + Pi) * R * 0.7
P8(1) = PO(1) + Sin(XD.angle + Pi) * R * 0.7
P8(2) = P1(2)
XD.Delete
'二维多线段绘制
Dim DDX As AcadLWPolyline '三维多线段为AcadPolyline
Dim P(0 To 11) As Double '三维多线段数组必须是三的陪数,前三个为一个坐标。
P(0) = P8(0): P(1) = P8(1) '二维两个为一个坐标
P(2) = P6(0): P(3) = P6(1)
P(4) = P4(0): P(5) = P4(1)
P(6) = P3(0): P(7) = P3(1)
P(8) = P5(0): P(9) = P5(1)
P(10) = P7(0): P(11) = P7(1)
ThisDrawing.ModelSpace.AddLightWeightPolyline P '绘制二维多线段,三维多线段为AddPolyline
End
E:
End Sub
'******************************************************************************************
'*********************************************************************************************
'管道折断线绘制***********************************************管道折断线绘制**********************
'
Sub DrawGDDDX()
On Error GoTo E:
'捕捉两个端点
Dim P1 As Variant, P2 As Variant
ThisDrawing.Utility.InitializeUserInput 1, ""
P1 = ThisDrawing.Utility.GetPoint(, "指定折断的第一点: ")
ThisDrawing.Utility.InitializeUserInput 1, ""
P2 = ThisDrawing.Utility.GetPoint(P1, "指定折断的第二点: ")
'获得两点间的距离
'ThisDrawing.ModelSpace.AddPoint P1
'ThisDrawing.ModelSpace.AddPoint P2
Dim L As Double
L = P2PDistance(P1, P2)
'所画圆弧的半径
Dim R As Double
R = 0.6 * L
'获得中点坐标
Dim PO(2) As Double, PO1(2) As Double, PO2(2) As Double
PO(0) = (P1(0) + P2(0)) / 2: PO(1) = (P1(1) + P2(1)) / 2: PO(2) = (P1(2) + P2(2)) / 2
PO1(0) = (P1(0) + PO(0)) / 2: PO1(1) = (P1(1) + PO(1)) / 2: PO1(2) = (P1(2) + PO(2)) / 2
PO2(0) = (P2(0) + PO(0)) / 2: PO2(1) = (P2(1) + PO(1)) / 2: PO2(2) = (P2(2) + PO(2)) / 2
'ThisDrawing.ModelSpace.AddPoint PO
'ThisDrawing.ModelSpace.AddPoint PO1
'ThisDrawing.ModelSpace.AddPoint PO2
'两点与x正方向成的角
Dim A As Double
A = ThisDrawing.Utility.AngleFromXAxis(P2, P1)
'所画圆弧圆心
Dim Pi As Double ' 圆周率
'Pi = 3.14159265358973
Pi = 4 * Atn(1) '计算圆周率,反正切直为1对应的是45度。
'创建匿名块
Dim BlockObj As AcadBlock
Set BlockObj = ThisDrawing.Blocks.Add _
(P1, "*A")
'计算三个圆弧的圆心
Dim C1(2) As Double, C2(2) As Double, C3(2) As Double
C1(0) = PO1(0) + Cos(A + Pi / 2) * R: C1(1) = PO1(1) + Sin(A + Pi / 2) * R: C1(2) = PO(2)
'ThisDrawing.ModelSpace.AddPoint C1
Dim StartA As Double, EndA As Double, R1 As Double
'圆弧起点的角度
'使用 AngleFromXAxis 方法查看直线与 X 轴所成的角度
StartA = ThisDrawing.Utility.AngleFromXAxis(C1, PO)
'圆弧终点的角度
EndA = ThisDrawing.Utility.AngleFromXAxis(C1, P1)
'圆弧的半径
R1 = P2PDistance(C1, PO)
'向块添加圆弧
BlockObj.AddArc C1, R1, StartA, EndA
C2(0) = PO2(0) + Cos(A + Pi / 2) * R: C2(1) = PO2(1) + Sin(A + Pi / 2) * R: C2(2) = PO(2)
'ThisDrawing.ModelSpace.AddPoint C2
StartA = ThisDrawing.Utility.AngleFromXAxis(C2, P2)
EndA = ThisDrawing.Utility.AngleFromXAxis(C2, PO)
BlockObj.AddArc C2, R1, StartA, EndA
C3(0) = PO2(0) + Cos(A - Pi / 2) * R: C3(1) = PO2(1) + Sin(A - Pi / 2) * R: C3(2) = PO(2)
'ThisDrawing.ModelSpace.AddPoint C3
StartA = ThisDrawing.Utility.AngleFromXAxis(C3, PO)
EndA = ThisDrawing.Utility.AngleFromXAxis(C3, P2)
BlockObj.AddArc C3, R1, StartA, EndA
'插入块
ThisDrawing.ModelSpace.InsertBlock P1, BlockObj.Name, 1, 1, 1, 0
End
E:
End Sub
'*********************************************************************************************
'管道折断线绘制***********************************************管道折断线绘制**********************
'
Sub DrawGDDDX()
On Error GoTo E:
'捕捉两个端点
Dim P1 As Variant, P2 As Variant
ThisDrawing.Utility.InitializeUserInput 1, ""
P1 = ThisDrawing.Utility.GetPoint(, "指定折断的第一点: ")
ThisDrawing.Utility.InitializeUserInput 1, ""
P2 = ThisDrawing.Utility.GetPoint(P1, "指定折断的第二点: ")
'获得两点间的距离
'ThisDrawing.ModelSpace.AddPoint P1
'ThisDrawing.ModelSpace.AddPoint P2
Dim L As Double
L = P2PDistance(P1, P2)
'所画圆弧的半径
Dim R As Double
R = 0.6 * L
'获得中点坐标
Dim PO(2) As Double, PO1(2) As Double, PO2(2) As Double
PO(0) = (P1(0) + P2(0)) / 2: PO(1) = (P1(1) + P2(1)) / 2: PO(2) = (P1(2) + P2(2)) / 2
PO1(0) = (P1(0) + PO(0)) / 2: PO1(1) = (P1(1) + PO(1)) / 2: PO1(2) = (P1(2) + PO(2)) / 2
PO2(0) = (P2(0) + PO(0)) / 2: PO2(1) = (P2(1) + PO(1)) / 2: PO2(2) = (P2(2) + PO(2)) / 2
'ThisDrawing.ModelSpace.AddPoint PO
'ThisDrawing.ModelSpace.AddPoint PO1
'ThisDrawing.ModelSpace.AddPoint PO2
'两点与x正方向成的角
Dim A As Double
A = ThisDrawing.Utility.AngleFromXAxis(P2, P1)
'所画圆弧圆心
Dim Pi As Double ' 圆周率
'Pi = 3.14159265358973
Pi = 4 * Atn(1) '计算圆周率,反正切直为1对应的是45度。
'创建匿名块
Dim BlockObj As AcadBlock
Set BlockObj = ThisDrawing.Blocks.Add _
(P1, "*A")
'计算三个圆弧的圆心
Dim C1(2) As Double, C2(2) As Double, C3(2) As Double
C1(0) = PO1(0) + Cos(A + Pi / 2) * R: C1(1) = PO1(1) + Sin(A + Pi / 2) * R: C1(2) = PO(2)
'ThisDrawing.ModelSpace.AddPoint C1
Dim StartA As Double, EndA As Double, R1 As Double
'圆弧起点的角度
'使用 AngleFromXAxis 方法查看直线与 X 轴所成的角度
StartA = ThisDrawing.Utility.AngleFromXAxis(C1, PO)
'圆弧终点的角度
EndA = ThisDrawing.Utility.AngleFromXAxis(C1, P1)
'圆弧的半径
R1 = P2PDistance(C1, PO)
'向块添加圆弧
BlockObj.AddArc C1, R1, StartA, EndA
C2(0) = PO2(0) + Cos(A + Pi / 2) * R: C2(1) = PO2(1) + Sin(A + Pi / 2) * R: C2(2) = PO(2)
'ThisDrawing.ModelSpace.AddPoint C2
StartA = ThisDrawing.Utility.AngleFromXAxis(C2, P2)
EndA = ThisDrawing.Utility.AngleFromXAxis(C2, PO)
BlockObj.AddArc C2, R1, StartA, EndA
C3(0) = PO2(0) + Cos(A - Pi / 2) * R: C3(1) = PO2(1) + Sin(A - Pi / 2) * R: C3(2) = PO(2)
'ThisDrawing.ModelSpace.AddPoint C3
StartA = ThisDrawing.Utility.AngleFromXAxis(C3, PO)
EndA = ThisDrawing.Utility.AngleFromXAxis(C3, P2)
BlockObj.AddArc C3, R1, StartA, EndA
'插入块
ThisDrawing.ModelSpace.InsertBlock P1, BlockObj.Name, 1, 1, 1, 0
End
E:
End Sub
'*********************************************************************************************
[本日志由 田草 于 2007-11-23 03:57 PM 编辑]
|
tiancao1001 于 2009-02-21 09:14 AM 发表评论:
P2PDistance,就是个求点到点的直线距离的,你自己补充吧?
我分享的代码只能提供一种思路,和解决方法。
luojunxu 于 2009-02-20 11:14 PM 发表评论:
缺少一个函数P2PDistance
发表评论 - 不要忘了输入验证码哦! |