明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2485|回复: 0

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

[复制链接]
发表于 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 这些参数分别代表什么?运行可以,但是看不懂啊!请给指点,谢谢啊!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 07:22 , Processed in 0.167155 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表