eeko 发表于 2003-7-28 16:17:00

在VBA中，怎么用Spile画螺旋线？

在VBA中，怎么用Spile画螺旋线？谁会知道，请赐教！

topirol 发表于 2003-7-28 20:54:00

看看下面



http://www.mjtd.com/function/list.asp?id=76&ordertype=byletter

mccad 发表于 2003-7-28 20:59:00

其实也就是通过公式计算点，然后再形成一条样条曲线罢了

eeko 发表于 2003-7-29 10:23:00

我是用公式生成点，然后手工用Spline连成圆锥螺旋线，可是用在vba中，用spline时，生成的只是一团"乱麻",不知是什么原因?而且object.AddSpline(PointsArray, StartTangent, EndTangent)中的“StartTangent, EndTangent"不知要怎么制定。请高手帮帮我。

mccad 发表于 2003-7-29 13:01:00

Sub addsph()
    Dim EentPnt As Variant
    EentPnt = ThisDrawing.Utility.GetPoint(, "GetPoint")
   
AddHelix EentPnt, 5, 45, 10, 5
End Sub
Public Function AddHelix(varCentPnt As Variant, _
dblRadius As Double, dblStartAng As Double, _
dblPitch As Double, dblRot As Double) As AcadSpline
Dim objPoly As AcadSpline
Dim objSpace As AcadBlock
Dim objUtil As AcadUtility
Dim varSegments As Variant
Dim dblSegInclAng As Double
Dim dblSegPitch As Double
Dim dblSegAng As Double
Dim varPitchPnt As Variant
Dim intCnt As Integer
Dim dblPnts() As Double
Dim intLoopCnt As Integer
Dim intVertCnt As Integer
Dim intCoordCnt As Integer
On Error GoTo Err_Control
If ThisDrawing.ActiveSpace = acModelSpace Then
    Set objSpace = ThisDrawing.ModelSpace
Else
    Set objSpace = ThisDrawing.PaperSpace
End If
Set objUtil = ThisDrawing.Utility
varSegments = ThisDrawing.GetVariable("SURFTAB1")
dblSegInclAng = (2 * (Atn(1) * 4)) / varSegments
dblSegPitch = dblPitch / varSegments
dblSegAng = dblStartAng - dblSegInclAng
intLoopCnt = CInt(1 + (varSegments * dblRot))
ReDim dblPnts((intLoopCnt * 3) - 1)
For intCnt = 1 To intLoopCnt
    dblSegAng = dblSegInclAng + dblSegAng
    varPitchPnt = objUtil.PolarPoint(varCentPnt, _
    dblSegAng, dblRadius)
    varCentPnt(2) = varCentPnt(2) + dblSegPitch
    For intVertCnt = 0 To 2
      dblPnts(intCoordCnt) = varPitchPnt(intVertCnt)
      intCoordCnt = intCoordCnt + 1
    Next
Next intCnt
Dim st(2) As Double
Dim et(2) As Double
st(0) = 0: st(1) = 0: st(2) = 0
et(0) = 0: et(1) = 0: et(2) = 0
Set objPoly = objSpace.AddSpline(dblPnts, st, et)
Set AddHelix = objPoly
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
'Cases here
Case Else
    MsgBox Err.Description
    Err.Clear
    Resume Exit_Here
End Select
End Function

huiyi88 发表于 2010-7-29 08:59:00

<p>cad2007开始就有helix命令，怎么利用vba来调用这个命令来画图，实现参数化呢？谢谢回复。</p>
页: [1]
查看完整版本: 在VBA中，怎么用Spile画螺旋线？