这是我去年刚学VBA是写的一个三维螺旋线程序
<p>好好学习这段程序,在工作中比较有用.</p><p>还有MJTD的VBA函数</p><p>函数名：<b>AddHelix</b></p><p> <a href="http://www.mjtd.com/function/list.asp?id=76&ordertype=byletter">http://www.mjtd.com/function/list.asp?id=76&ordertype=byletter</a></p><p>Public Function AddHelix(varCentPnt As Variant, _<br/>dblRadius As Double, dblStartAng As Double, _<br/>dblPitch As Double, dblRot As Double) As Acad3DPolyline<br/> Dim objPoly As Acad3DPolyline<br/> Dim objSpace As AcadBlock<br/> Dim objUtil As AcadUtility<br/> Dim varSegments As Variant<br/> Dim dblSegInclAng As Double<br/> Dim dblSegPitch As Double<br/> Dim dblSegAng As Double<br/> Dim varPitchPnt As Variant<br/> Dim intCnt As Integer<br/> Dim dblPnts() As Double<br/> Dim intLoopCnt As Integer<br/> Dim intVertCnt As Integer<br/> Dim intCoordCnt As Integer<br/> On Error GoTo Err_Control<br/> If ThisDrawing.ActiveSpace = acModelSpace Then<br/> Set objSpace = ThisDrawing.ModelSpace<br/> Else<br/> Set objSpace = ThisDrawing.PaperSpace<br/> End If<br/> Set objUtil = ThisDrawing.Utility<br/> varSegments = ThisDrawing.GetVariable("SURFTAB1")<br/> dblSegInclAng = (2 * (Atn(1) * 4)) / varSegments<br/> dblSegPitch = dblPitch / varSegments<br/> dblSegAng = dblStartAng - dblSegInclAng<br/> intLoopCnt = CInt(1 + (varSegments * dblRot))<br/> ReDim dblPnts((intLoopCnt * 3) - 1)<br/> For intCnt = 1 To intLoopCnt<br/> dblSegAng = dblSegInclAng + dblSegAng<br/> varPitchPnt = objUtil.PolarPoint(varCentPnt, _<br/> dblSegAng, dblRadius)<br/> varCentPnt(2) = varCentPnt(2) + dblSegPitch<br/> For intVertCnt = 0 To 2<br/> dblPnts(intCoordCnt) = varPitchPnt(intVertCnt)<br/> intCoordCnt = intCoordCnt + 1<br/> Next<br/> Next intCnt<br/> Set objPoly = objSpace.Add3DPoly(dblPnts)<br/> Set AddHelix = objPoly<br/>Exit_Here:<br/> Exit Function<br/>Err_Control:<br/> Select Case Err.Number<br/> 'Cases here<br/> Case Else<br/> MsgBox Err.Description<br/> Err.Clear<br/> Resume Exit_Here<br/> End Select<br/>End Function <td></td></p>
页:
[1]