|
|
我按照cad帮助里编辑了一下gardenpath的程序，在vb编辑器中点击运行，可以在cad绘图窗口使用。但是我想把它作为一个程序，就像调用line一样，在命令栏中输入‘line’即可花直线。高手指点一下。我加载过，但是加载完老说，没有此（gardenpath）命令
源码：
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( _
, "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)
' 执行命令，调用各个函数
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
|
|
置顶卡
