- UID
- 25232
- 积分
- 2113
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-1-12
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
这段代码是ACAD帮助文件中的(我略作了些修改),有个问题我不懂:变量pd是怎么赋值的?(单步运行中可知为半径+间距)我找不到赋值语句!
Const pi = 3.14159
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( _
, "路的起点: ")
sp(0) = varRet(0)
sp(1) = varRet(1)
sp(2) = varRet(2)
varRet = ThisDrawing.Utility.GetPoint( _
, "路的端点: ")
ep(0) = varRet(0)
ep(1) = varRet(1)
ep(2) = varRet(2)
hwidth = ThisDrawing.Utility. _
GetDistance(sp, "路的半宽: ")
trad = ThisDrawing.Utility. _
GetDistance(sp, "砖的半径: ")
tspac = ThisDrawing.Utility. _
GetDistance(sp, "砖之间的间距: ")
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
ZoomExtents
End Sub |
|