有关曾经发布螺栓源码中的一点问题？

littlerain 发表于 2005-4-21 10:34:00

Public Sub m(d1, h, c, d, r, k, s, c2, dw As Double)

'设置环境参数，不设置任何捕捉 Dim sysOSMODE As Integer sysOSMODE = ThisDrawing.GetVariable("osmode") ThisDrawing.SetVariable "osmode", 0

'设置初始化用户输入状态 ThisDrawing.Utility.InitializeUserInput 32

On Error Resume Next '错误状态处理 Dim fp, sp As Variant

'捕捉用户输入点 fp = ThisDrawing.Utility.GetPoint(, "请输入螺栓前视图的中心点:") sp = ThisDrawing.Utility.GetPoint(fp, "请输入螺栓侧视图的基准点:") l = ThisDrawing.Utility.GetDistance(, "请输入螺栓长度 L:") rotsita = ThisDrawing.Utility.GetAngle(, "请输入螺栓的旋转角度<0>:")

'错误状态处理 If Err Then rotsita = 0# Err.Clear End If

'设SP点为侧图绘图基准点,xzom为X方向坐标,yzom为Y方向坐标 xzom = sp(0) + 0 yzom = sp(1) + 0

'定义AP为系列定义参数, Dim ap As Variant Dim utilObj As Object Set utilObj = ThisDrawing.Utility

utilObj.CreateTypedArray ap, vbDouble, xzom, yzom, 0 If s >= l Then s = l - 2# * k End If

hrad = d / 2#

Dim mx As String mx = "M" & CStr(Fix(d1)) & CStr(Fix(h)) & CStr(Fix(l)) mmx = mx

'绘制螺栓前视图的圆 Dim circ As AcadCircle Set circ = ThisDrawing.ModelSpace.AddCircle(fp, hrad)

'绘制螺栓前视图的六边形 Dim fpstr As String fpstr = fp(0) & "," & fp(1) & "," & fp(2) ThisDrawing.SendCommand ("_polygon" & vbCr & "6" & _ vbCr & fpstr & vbCr & "c" & vbCr & hrad & vbCr)

'**************************************************** '定义当前图层设置。 Dim flagno As Integer flagno = 0

Dim iblock As Integer iblock = ThisDrawing.Blocks.Count While (iblock > 0) If ThisDrawing.Blocks.Item(iblock - 1).Name = mx Then flagno = 1 End If iblock = iblock - 1 Wend

 If flagno = 0 Then Dim layerold As Integer layerold = ThisDrawing.GetVariable("clayer") '设置各点参数值 rr = r c40 = c / 4# ax0 = ap(0) ax1 = ax0 - h ax2 = ((c / 2# - d / 2#) / 1.732 + ax0) - h ax3 = (1.5 - 1.414) * d1 + ax0 - h ax5 = ax0 + rr + c2 ax6 = ax0 - s + l - d1 / 5# + c2 ax7 = ax0 + l - s + c2 ax8 = ax0 + l - k + c2 ax9 = ax0 + l + c2 ax10 = (ax1 + ax2) / 2# ax11 = ax8 + d1 / 10# ay0 = ap(1) ay2 = ay0 + d1 / 2# ay3 = ay0 + c * 3 / 8 ay4 = ay0 + d / 2# ay5 = ay0 + c / 2# ay6 = ay0 + r + d1 / 2# ay7 = ay0 + d1 / 2# - k ay8 = (ay4 + ay5) / 2# ay9 = ay2 - d1 / 10# ccrad = 1.5 * d1 '设置各参数点 Dim p10, p32, p13, p14, p25, p05, p06, p52, p72, p77, _ p70, p82, p80, p90, p97, p62, p02, p108, p79, p119, p1, p2 As Variant utilObj.CreateTypedArray p10, vbDouble, ax1, ay0, 0 utilObj.CreateTypedArray p32, vbDouble, ax3, ay2, 0 utilObj.CreateTypedArray p13, vbDouble, ax1, ay3, 0 utilObj.CreateTypedArray p14, vbDouble, ax1, ay4, 0 utilObj.CreateTypedArray p25, vbDouble, ax2, ay5, 0 utilObj.CreateTypedArray p05, vbDouble, ax0, ay5, 0 utilObj.CreateTypedArray p06, vbDouble, ax0 + c2, ay6, 0 utilObj.CreateTypedArray p52, vbDouble, ax5, ay2, 0 utilObj.CreateTypedArray p72, vbDouble, ax7, ay2, 0 utilObj.CreateTypedArray p77, vbDouble, ax7, ay7, 0 utilObj.CreateTypedArray p70, vbDouble, ax7, ay0, 0 utilObj.CreateTypedArray p82, vbDouble, ax8, ay2, 0 utilObj.CreateTypedArray p80, vbDouble, ax8, ay0, 0 utilObj.CreateTypedArray p90, vbDouble, ax9, ay0, 0 utilObj.CreateTypedArray p97, vbDouble, ax9, ay7, 0 utilObj.CreateTypedArray p62, vbDouble, ax6, ay2, 0 utilObj.CreateTypedArray p02, vbDouble, ax0, ay2, 0 utilObj.CreateTypedArray p108, vbDouble, ax10, ay8, 0 utilObj.CreateTypedArray p79, vbDouble, ax7, ay9, 0 utilObj.CreateTypedArray p119, vbDouble, ax11, ay9, 0 utilObj.CreateTypedArray p1, vbDouble, ax0 + c2, ay0, 0 utilObj.CreateTypedArray p2, vbDouble, ax0 + c2, ay0 + dw / 2, 0 

' 生成块

Set blockObj = ThisDrawing.Blocks.Add(ap, mx) Dim linea, lineb, linec, lined, linee, linef, lineg, lineh, linei, linej, _ linek, linep, lineq As AcadLine

'绘制螺栓侧视图的一侧各条线段 Set linea = blockObj.AddLine(p10, p14) Set lineb = blockObj.AddLine(p14, p25) Set linec = blockObj.AddLine(p25, p05) Set lined = blockObj.AddLine(p05, ap) Set linee = blockObj.AddLine(p06, ap) Set linef = blockObj.AddLine(p32, p02) Set lineg = blockObj.AddLine(p52, p82) Set lineh = blockObj.AddLine(p82, p80) Set linei = blockObj.AddLine(p82, p97) Set linej = blockObj.AddLine(p97, p90) Set linek = blockObj.AddLine(p72, p70) Set linep = blockObj.AddLine(p1, p2) Set lineq = blockObj.AddLine(p2, p05) dist = distance(p32, p10) pi = 3.1415926536 ang1 = Atn(Sqr(ccrad ^ 2 - (dist / 2#) ^ 2) * 2 / dist) ang2 = ThisDrawing.Utility.AngleFromXAxis(p32, p10) ang3 = ang1 + ang2 - 2 * pi Dim cenPt As Variant cenPt = ThisDrawing.Utility.PolarPoint(p32, ang3, ccrad) angs = ThisDrawing.Utility.AngleFromXAxis(cenPt, p32) ange = ThisDrawing.Utility.AngleFromXAxis(cenPt, p10) Dim arca As AcadArc Set arca = blockObj.AddArc(cenPt, ccrad, angs, ange) Dim arcb As AcadArc Dim cenPt2 As Variant '利用 p108, p13, p32 绘制圆弧 cenPt2 = centerPt(p108, p13, p32) arcb_ra = distance(cenPt2, p108) arcb_angs = ThisDrawing.Utility.AngleFromXAxis(cenPt2, p108) arcb_ange = ThisDrawing.Utility.AngleFromXAxis(cenPt2, p32) Set arcb = blockObj.AddArc(cenPt2, arcb_ra, arcb_angs, arcb_ange) 'arcc distc = distance(p06, p52) ang1c = Atn(Sqr(rr ^ 2 - (distc / 2#) ^ 2) * 2 / distc) ang2c = ThisDrawing.Utility.AngleFromXAxis(p06, p52) ang3c = ang1c + ang2c - 2 * pi Dim cenPt3 As Variant cenPt3 = ThisDrawing.Utility.PolarPoint(p06, ang3c, rr) arcc_angs = ThisDrawing.Utility.AngleFromXAxis(cenPt3, p06) arcc_ange = ThisDrawing.Utility.AngleFromXAxis(cenPt3, p52) '绘制螺栓侧视图的圆弧 Dim arcc As AcadArc Set arcc = blockObj.AddArc(cenPt3, rr, arcc_angs, arcc_ange) 'color 3 Dim linel, linem As AcadLine Set linel = blockObj.AddLine(p62, p79) Set linem = blockObj.AddLine(p79, p119) linel.Color = 3 linem.Color = 3 '对绘制的螺栓进行镜像 Dim acadent As AcadEntity For Each acadent In blockObj acadent.Mirror p10, ap Next acadent End If

Dim insertPt As Variant utilObj.CreateTypedArray insertPt, vbDouble, sp(0), sp(1), sp(2) Dim blockRefObj As AcadBlockReference Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertPt, mx, 1#, 1#, 1#, 0) ThisDrawing.Regen acActiveViewport 

ThisDrawing.SetVariable "osmode", sysOSMODE End Sub

各位大侠，这个是斑竹所提供的螺栓源码中thisdrawing部分，也就是代码的核心部分，我想问一下，

Public Sub m(d1, h, c, d, r, k, s, c2, dw As Double)中，的d1, h, c, d, r, k, s, c2, dw 这些参数分别代表什么？运行可以，但是看不懂啊！请给指点，谢谢啊！

页: [1]

明经CAD社区's Archiver

有关曾经发布螺栓源码中的一点问题？