我怎样才能在A中绘制螺旋描记器
螺旋描记器，正如你们中的一些人可能知道的，是通过将一个圆滑入或滑出另一个半径不同的圆而获得的曲线。还有一个用来绘制这些图形的玩具。我在一个网站上读到，也可以在电脑上画出来(http://wordsmith.org/anu/java/spirograph.html)但我没能成功。
我想知道有没有可能在AutoCad中编写VBA，以便在AutoCad中绘制它们？
如有任何评论，我们将不胜感激。
BR
霍什拉凡 你可以很容易地用环形阵列模拟它们。
Autocad：
从网站：
KC公司 Autodesk实验室有一个插件，应该可以与2007及更高版本配合使用
http://labs.blogs.com/its_alive_in_the_lab/2010/05/adn-plugin-of-the-month-spiro-for-autocad-now-available.html
下载页面（2010年5月）http://labs.autodesk.com/utilities/adn_plugins/supported_apps/ 甚至只是一个围绕自身排列的简单圆圈：
对于真实的应用程序，您需要一些程序，但对于装饰，请使用上面的array命令。 我在论坛上搜索了你：http://www.cadtutor.net/forum/showthread.php?32051-有些不同。。。
不要在第一页就停止阅读。
谢谢我会检查这些页面。
也感谢福卡罗。 这是我的尝试。It基础；需要非常具体的设置。有关布线所需的一般方向，请参阅随附文件。对于某些半径比，这个例程将受益于一些递归，但这是我可以投入的全部时间。
Option Explicit
Const TwoPi As Double = 3.14159265359 * 2
Sub CreatePattern()
Dim StationaryCircle As AcadCircle
Dim RotatingCircle As AcadCircle
Dim PenPoint As AcadPoint
Dim tempPoint As AcadPoint
Dim varPkPt As Variant
Dim rotationAngle As Double
Dim ent As AcadEntity
Dim Origin(2) As Double
Dim PenPt() As Double
Dim SpiroCurve As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 194) As Double
Dim RadRatio As Double
Dim vararray As Variant
Dim varNewarray As Variant
Dim NumOfArray As Integer
Dim NumOfInitialRotations As Integer
Dim Remain As Double
Dim count As Integer
Dim SeqBlock As AcadBlock
Dim ref As AcadBlockReference
On Error Resume Next
With ThisDrawing.Utility
.GetEntity ent, varPkPt, "Select Circle at WCS origin: "
If Err <> 0 Then Exit Sub
If TypeOf ent Is AcadCircle Then
Set StationaryCircle = ent
Else: Exit Sub
End If
If Round(DistBetween2PtST(Origin, StationaryCircle.center), 6) <> 0 Then Exit Sub
.GetEntity ent, varPkPt, "Select Circle that rotates: "
If Err <> 0 Then Exit Sub
If TypeOf ent Is AcadCircle Then
Set RotatingCircle = ent
Else: Exit Sub
End If
If (StationaryCircle.radius + RotatingCircle.radius) - RotatingCircle.center(0) > 0.0000001 Then
.Prompt "Circles are not situated correctly! Operation Cancelled. "
Exit Sub
End If
RadRatio = StationaryCircle.radius / RotatingCircle.radius
NumOfInitialRotations = Round(RadRatio)
Remain = RadRatio - NumOfInitialRotations
If Abs(Remain) < 0.0000001 Then
NumOfArray = 0
Remain = 0
End If
.GetEntity ent, varPkPt, "Select Pen Point in rotating circle: "
If Err <> 0 Then Exit Sub
On Error GoTo 0
If TypeOf ent Is AcadPoint Then
Set PenPoint = ent
PenPt = PenPoint.Coordinates
Else: Exit Sub
End If
Dim i As Integer
fitPoints(0) = PenPt(0)
fitPoints(1) = PenPt(1)
fitPoints(2) = PenPt(2)
For i = 1 To 64
Set tempPoint = PenPoint.Copy
tempPoint.Rotate RotatingCircle.center, (TwoPi / 64) * i
tempPoint.Rotate StationaryCircle.center, (TwoPi / 64) * i * (RotatingCircle.radius / StationaryCircle.radius)
varPkPt = tempPoint.Coordinates
fitPoints(i * 3) = varPkPt(0)
fitPoints(i * 3 + 1) = varPkPt(1)
fitPoints(i * 3 + 2) = varPkPt(2)
tempPoint.Delete
Next
Set SeqBlock = ThisDrawing.Blocks.Add(Origin, "oneTurn")
Set SpiroCurve = SeqBlock.AddSpline(fitPoints, startTan, endTan)
rotationAngle = (TwoPi / RadRatio)
For i = 0 To NumOfInitialRotations - 1
Set ent = SpiroCurve.Copy
ent.Rotate Origin, rotationAngle * i
Next
Set ref = ThisDrawing.ModelSpace.InsertBlock(Origin, "oneTurn", 1, 1, 1, 0)
If Remain <> 0 Then
rotationAngle = (rotationAngle * NumOfInitialRotations) - TwoPi
NumOfArray = Floor(Abs(TwoPi / rotationAngle), 1)
For i = 0 To NumOfArray - 1
Set ent = ref.Copy
ent.Rotate Origin, rotationAngle * i
Next
End If
End With
End Sub
Function DistBetween2PtST(dblPt1 As Variant, dblPt2 As Variant) As Double
DistBetween2PtST = Sqr((dblPt2(0) - dblPt1(0)) ^ 2 + (dblPt2(1) - dblPt1(1)) ^ 2 + (dblPt2(2) - dblPt1(2)) ^ 2)
End Function
Public Function Floor(ByVal X As Double, Optional ByVal Factor As Double = 1) As Double
Floor = Int(X / Factor) * Factor
End Function
螺旋体。图纸
谢谢
我会试试的。
页:
[1]