Const pi = 3.1415926535897932384626433832795
Private sp(0 To 2) As Double
Private ep(0 To 2) As Double
Private hwidth As Double
Private trad As Double
Private tspac As Double
Private pangle As Double
Private plength As Double
Private totalwidth As Double
Private angp90 As Double
Private angm90 As Double
'角度---->弧度
Function dtr(a As Double) As Double
dtr = (a / 180) * pi
End Function
' 计算两点之间的距离
Function distance(sp As Variant, ep As Variant) As Double
Dim x As Double
Dim y As Double
Dim z As Double
x = sp(0) - ep(0)
y = sp(1) - ep(1)
z = sp(2) - ep(2)
distance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
End Function
' 获取花园小路的信息
Private Sub gpuser()
Dim varRet As Variant
varRet = ThisDrawing.Utility.GetPoint( _
, "Start point of path: ")
sp(0) = varRet(0)
sp(1) = varRet(1)
sp(2) = varRet(2)
varRet = ThisDrawing.Utility.GetPoint( _
, "Endpoint of path: ")
ep(0) = varRet(0)
ep(1) = varRet(1)
ep(2) = varRet(2)
hwidth = ThisDrawing.Utility. _
GetDistance(sp, "Half width of path: ")
trad = ThisDrawing.Utility. _
GetDistance(sp, "Radius of tiles: ")
tspac = ThisDrawing.Utility. _
GetDistance(sp, "Spacing between tiles: ")
pangle = ThisDrawing.Utility.AngleFromXAxis( _
sp, ep)
totalwidth = 2 * hwidth
plength = distance(sp, ep)
angp90 = pangle + dtr(90)
angm90 = pangle - dtr(90)
End Sub
' 绘制路的轮廓
Private Sub drawout()
Dim points(0 To 9) As Double
Dim pline As AcadLWPolyline
Dim varRet As Variant
varRet = ThisDrawing.Utility.PolarPoint( _
sp, angm90, hwidth)
points(0) = varRet(0)
points(1) = varRet(1)
points(8) = varRet(0)
points(9) = varRet(1)
varRet = ThisDrawing.Utility.PolarPoint( _
varRet, pangle, plength)
points(2) = varRet(0)
points(3) = varRet(1)
varRet = ThisDrawing.Utility.PolarPoint( _
varRet, angp90, totalwidth)
points(4) = varRet(0)
points(5) = varRet(1)
varRet = ThisDrawing.Utility.PolarPoint( _
varRet, pangle + dtr(180), plength)
points(6) = varRet(0)
points(7) = varRet(1)
Set pline = ThisDrawing.ModelSpace. _
AddLightWeightPolyline(points)
End Sub
' °´ÑØС·µÄ¸ø¶¨¾àÀë·ÅÖÃÒ»ÐдÉש
' ²¢ÇÒ¿ÉÄÜÐèҪƫÒÆ
Private Sub drow(pd As Double, offset As Double)
Dim pfirst(0 To 2) As Double
Dim pctile(0 To 2) As Double
Dim pltile(0 To 2) As Double
Dim cir As AcadCircle
Dim varRet As Variant
varRet = ThisDrawing.Utility.PolarPoint( _
sp, pangle, pd)
pfirst(0) = varRet(0)
pfirst(1) = varRet(1)
pfirst(2) = varRet(2)
varRet = ThisDrawing.Utility.PolarPoint( _
pfirst, angp90, offset)
pctile(0) = varRet(0)
pctile(1) = varRet(1)
pctile(2) = varRet(2)
pltile(0) = pctile(0)
pltile(1) = pctile(1)
pltile(2) = pctile(2)
Do While distance(pfirst, pltile) < (hwidth - trad)
Set cir = ThisDrawing.ModelSpace.AddCircle( _
pltile, trad)
varRet = ThisDrawing.Utility.PolarPoint( _
pltile, angp90, (tspac + trad + trad))
pltile(0) = varRet(0)
pltile(1) = varRet(1)
pltile(2) = varRet(2)
Loop
varRet = ThisDrawing.Utility.PolarPoint( _
pctile, angm90, tspac + trad + trad)
pltile(0) = varRet(0)
pltile(1) = varRet(1)
pltile(2) = varRet(2)
Do While distance(pfirst, pltile) < (hwidth - trad)
Set cir = ThisDrawing.ModelSpace.AddCircle( _
pltile, trad)
varRet = ThisDrawing.Utility.PolarPoint( _
pltile, angm90, (tspac + trad + trad))
pltile(0) = varRet(0)
pltile(1) = varRet(1)
pltile(2) = varRet(2)
Loop
End Sub
' »æÖÆÿÐдÉש
Private Sub drawtiles()
Dim pdist As Double
Dim offset As Double
pdist = trad + tspac
offset = 0
Do While pdist <= (plength - trad)
drow pdist, offset
pdist = pdist + ((tspac + trad + trad) * Sin(dtr(60)))
If offset = 0 Then
offset = (tspac + trad + trad) * Cos(dtr(60))
Else
offset = 0
End If
Loop
End Sub
' Ö´ÐÐÃüÁµ÷Óø÷¸öº¯Êý
Sub gardenpath()
Dim sblip As Variant
Dim scmde As Variant
gpuser
sblip = ThisDrawing.GetVariable("blipmode")
scmde = ThisDrawing.GetVariable("cmdecho")
ThisDrawing.SetVariable "blipmode", 0
ThisDrawing.SetVariable "cmdecho", 0
drawout
drawtiles
ThisDrawing.SetVariable "blipmode", sblip
ThisDrawing.SetVariable "cmdecho", scmde
End Sub
关闭