在solidworks中绘制球面上平均分布n个点的球壳

1. matlab中算出单位元上给定任意数量平均分布点的坐标:

% function []=main()
    N=200; %点    数量
    a=rand(N,1)*2*pi;  %根据随机求面均匀分布,先生成一个初始状态
    b=asin(rand(N,1)*2-1);
    r0=[cos(a).*cos(b),sin(a).*cos(b),sin(b)];
    v0=zeros(size(r0));
    G=1e-2;%斥力常数,试验这个值比较不错
 
   for ii=1:300 %模拟200步,一般已经收敛,其实可以在之下退出
         [rn,vn]=countnext(r0,v0,G);%更新状态
          r0=rn;v0=vn;
    end

    plot3(rn(:,1),rn(:,2),rn(:,3),'o','MarkerFaceColor','#D9FFFF');
    hold on;%画结果
    [xx,yy,zz]=sphere(50); 
    h2=surf(xx,yy,zz); %画一个单位球做参考
    set(h2,'edgecolor','none','facecolor','r','facealpha',0.1);
    axis equal;
    axis([-1 1 -1 1 -1 1]);
    hold off;
    for i = 1:N %将所有点的三维坐标平铺至一维
        pp(3*i-2) = r0(i,1);
        pp(3*i-1) = r0(i,2);
        pp(3*i)   = r0(i,3);
    end
    fid = fopen('200.txt','wt');
    fprintf(fid,'%d ',pp); 
    fclose(fid);
%  end

function [rn vn]=countnext(r,v,G) %更新状态的函数
%r存放每点的x,y,z数据,v存放每点的速度数据
    num=size(r,1);
    dd=zeros(3,num,num); %各点间的矢量差
    
    for m=1:num-1
          for n=m+1:num
              dd(:,m,n)=(r(m,:)-r(n,:))';
              dd(:,n,m)=-dd(:,m,n);
          end
     end 

      L=sqrt(sum(dd.^2,1));%各点间的距离
      L(L<1e-2)=1e-2; %距离过小限定
      F=sum(dd./repmat(L.^3,[3 1 1]),3)';%计算合力

      Fr=r.*repmat(dot(F,r,2),[1 3]); %计算合力径向分量
      Fv=F-Fr; %切向分量

       rn=r+v;  %更新坐标
       rn=rn./repmat(sqrt(sum(rn.^2,2)),[1 3]);
       vn=v+G*Fv;%跟新速度
end

下图为单位圆上平均分布200个点的效果:

参考: 产生在球面上均匀分布的点 - 简书

2. 在python中将上面得到的数据格式转换一下

import numpy as np

path = r'E:\RA in AIRS\Sliding Sphere\SnailBot II\draw-holes\200.txt'

with open(path, "r") as f:    #打开文件
    data = f.read()   #读取文件
    # print(data)
#b = data.split('\n', -1) #以换行符分割
b = data.split()

#b = '='.join(data.split())
for index in range(len(b)):
    b[index] = eval(b[index])
# b=np.transpose(b)
# b = '='.join(b.split())
b = str(b)
print(b)

path = r'E:\RA in AIRS\Sliding Sphere\SnailBot II\draw-holes\200_e.txt'

with open(path, "w") as f:
     f.write(b)

3. 在solidworks中利用宏(vb)运行直接生成带孔球壳

以下是100个孔的案例代码,在solidworks中创建一个新零件,然后直接运行这个宏。

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long


Sub main()

Dim a As String
'a = "-0.577350269072=0.577350269072=-0.577350269072=0.577350269072=0.577350269072" & _
"= 0.577350269072=-0.577350269072=-0.577350269072=0.577350269072=0.577350269072=-0.577350269072=-0.577350269071"


'100
a = _
"0.592679436252, -0.800074524412, 0.092800006626, 0.831811244117, -0.517624489389, 0.200386980978, 0.509043317857, -0.819915787399, -0.261940837058, 0.782047307343, -0.604760319537, -0.150555521291, 0.975229788803, -0.213142261334, 0.059137428626, 0.898781143163," & _
"-0.152794034431, 0.410909284072, 0.717037759121, -0.442429506869, 0.538621372994, 0.275706229751, -0.961186396955, 0.010333691787, 0.206581507334, -0.907898919396, 0.364751467423, 0.516803715402, -0.732360561821, 0.443353050329, 0.232831074053, -0.704028710706, 0.670919716104, -0.110057099926, -0.839069280667, 0.532775916308, 0.636744709206, -0.58117959362, -0.506741013987, 0.324531110459, -0.657963745974, -0.679531652926, 0.91062292117, -0.293369635514, -0.291032906042, 0.841482855239, 0.092276948479, -0.532345347606, 0.979074433185, 0.052504539327, -0.196612633454, 0.920142785201, 0.386638183412, -0.062033619673, 0.973507483586, 0.127727205756, 0.189654792483, 0.720689074716, 0.691828096681, -0.044510023907, 0.805285991252, 0.43259126559, -0.405437" & _
"13351, 0.843046863913, 0.454033867083, 0.288314468573, 0.609117156844, 0.733960734221, 0.300462859368, 0.446987765083, -0.430901800545, 0.783916817114, 0.129353146528, -0.332260008946, 0.93427568198, 0.393619867237, -0.081168092872, 0.915682882234, -0.089418183949, -0.592183420595, 0.800826563465, -0.320755464643, -0.324275271255, 0.889922176572, 0.179317284832, 0.210818490934, 0.960937498093, 0.571419575315, 0.21287250987, 0.792568585984, 0.826122266768, 0.183509129075, 0.532772371558, 0.635216456468, 0.505497047667, 0.583928752701, 0.307250714176, 0.924697330804, 0.224792893665, 0.427491886725, 0.8961978562, -0.118659552193, 0.573911382916, 0.714833798519, -0.3995477006, 0.343570982656, 0.761689386765, 0.54935258074, -0.011731178629, 0.590809901099," & _
"0.806725504873, 0.340528205277, 0.495496931753, 0.799076549546, -0.012621242972, 0.840973038507, 0.540929803885, -0.334910910354, 0.673741943883, 0.658715777236, -0.193345817584, 0.300843527481, 0.933868602532, -0.082307706305, -0.041312772034, 0.995750318277," & _
"-0.053386459926, 0.977343070863, 0.204817986839, 0.056202317025, 0.988029941422, -0.14365978705, -0.346906389908, 0.937860976897, -0.008529047715, -0.368773129877, 0.861984967914, 0.347833715691, -0.631739299772, 0.630691946625, 0.450702923871, -0.512764563488, 0.374616802128, 0.772486086602, -0.784541463881, 0.310558331471, 0.536701233653, -0.723365548981, -0.014853694021, 0.690305476091, -0.623719083752, -0.36599496586, 0.690667929998, -0.408458937705, -0.655504514584, 0.635196920308, -0.424554078483, -0.845470115965, 0.323935359992, 0.244150699325, 0.867703757408, -0.432990329451, 0.377710262522, 0.616202957433, -0.691106990875, 0.61920944346, 0.34293644045, -0.706381103188, 0.574897169709, -0.001675430428, -0.818223952957, -0.429207650876," & _
"0.024005915392, 0.902886763916, -0.642348653394, 0.758619961867, 0.109013581448, -0.857597583501, 0.467142959271, 0.215183271603, -0.820030352267, 0.555700849165, -0.13691890884, -0.563312570237, 0.784505311082, -0.259288189274, -0.699956165297, 0.528354555964, -0.4805" & _
"23495632, -0.949013229206, 0.082094102563, 0.304359079242, -0.970645433045, 0.236438288567, -0.044095113202, -0.992210704791, -0.124401519801, 0.006494549223, -0.86260685285, -0.244332350146, 0.442957244086, -0.883821721868, -0.446457876067, 0.139765978876, -0.845125037127, -0.486775531215, -0.220937216945, -0.232327745705, 0.906075725848, -0.353624939173, -0.043753939995, 0.770930502201, -0.635414631175, -0.397038663031, 0.681538950304, -0.614707214271, -0.888085882676, 0.225395680236, -0.400624827392, -0.602593441727, 0.293260673957, -0.742212450109, -0.284594918573, 0.431738684385, -0.855924903673, 0.072581272787, 0.506876649217, -0.85895752009, 0.329712135838, 0.252812483142, -0.909601976608, 0.240842283669, -0.096731983293, -0.965731804284," & _
"-0.019378935755, 0.176554953633, -0.984099997559, -0.36750471523, 0.083305865442, -0.926283119282, -0.115352201231, -0.175549826082, -0.977689177721, -0.509869174347, -0.237717862533, -0.826754886822, 0.115026212975, -0.444248233413, -0.888488872996, 0.459790669296," & _
"-0.348054816783, -0.816976367432, -0.035425449989, -0.737910135756, -0.67396859648, -0.754339989022, -0.027294626986, -0.655916293669, -0.74227354376, -0.377477493034, -0.553661203704, -0.926118666278, -0.134793253744, -0.35232796471, -0.59929477356, -0.750156628826, -0.279483106129, -0.691196349253, -0.593052497168, 0.41296046104, -0.671503913813, -0.736877638846, 0.078063045694, -0.381868041983, -0.923223757467, -0.042833306682, -0.26992061797, -0.86429253534, -0.424430528297, -0.043548718589, -0.985340902175, -0.164944886583, 0.189788890082, -0.884216954694, -0.426779280463, -0.485059013401, -0.631289724463, -0.605137205355, -0.24393228059, -0.487462159303, -0.838378008856, -0.108981232017, -0.974929689732, 0.193997915318, 0.747720940235, -0.250692300758, -0.614871340911, 0.692935959045, -0.121434134034, 0.710699308958"





'a = My.Computer.FileSystem.ReadAllText("E:\RA in AIRS\Sliding Sphere\SnailBot II\draw-holes\vb\4.txt")
'a = "-577350269072E-01=577350269072E-01=-577350269072E-01=577350269072E-01=577350269072E-01=577350269072E-01"
Dim b() As String
b = Split(a, ",")

Dim i As Integer
Dim n As Integer
Dim j As Integer

n = (UBound(b) + 1) / 3 '孔的数量

Dim x(100) As Double '''''''''''''''''''''''''''''''''''''''''''''''
Dim y(100) As Double
Dim z(100) As Double

Dim tdcaotuP As String
Dim tdcaotuL As String
Dim refplane As String

For i = 0 To UBound(b)
    b(i) = Val(b(i)) 'MsgBox (b(i))
Next

For i = 0 To n - 1

x(i) = b(3 * i) * 0.06
y(i) = b(3 * i + 1) * 0.06
z(i) = b(3 * i + 2) * 0.06

Next

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("前视基准面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateArc(0#, 0#, 0#, 0#, 0.06, 0#, 0#, -0.06, 0#, 1)
Part.ClearSelection2 True
Set skSegment = Part.SketchManager.CreateArc(0#, 0#, 0#, 0#, 0.05, 0#, 0#, -0.05, 0#, 1)
Part.ClearSelection2 True
Set skSegment = Part.SketchManager.CreateLine(0#, 0.06, 0#, 0#, 0.05, 0#)
Part.ClearSelection2 True
Set skSegment = Part.SketchManager.CreateLine(0#, -0.06, 0#, 0#, -0.05, 0#)
Part.ClearSelection2 True
' Named View
Part.ShowNamedView2 "*上下二等角轴测", 8
Part.ViewZoomtofit2
boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", -1.40251072453109E-03, 0.055, -2.83512742367096E-03, True, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", -1.40251072453109E-03, 0.055, -2.83512742367096E-03, False, 16, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureRevolve2(True, True, False, False, False, False, 0, 0, 6.2831853071796, 0, False, False, 0.01, 0.01, 0, 0, 0, True, True, True)
Part.SelectionManager.EnableContourSelection = False
Part.ClearSelection2 True

For i = 0 To n - 1
j = i + 1
tdcaotuP = "Point2@3D草图" & j
tdcaotuL = "Line1@3D草图" & j
refplane = "基准面" & j

Part.SketchManager.Insert3DSketch True
Set skSegment = Part.SketchManager.CreateLine(0#, 0#, 0#, x(i), y(i), z(i)) '3D草图,两点确定一条直线
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
'boolstatus = Part.Extension.SelectByID2("Point2@3D草图1", "EXTSKETCHPOINT", x(i), y(i), z(i), True, 0, Nothing, 0) '选择点
'boolstatus = Part.Extension.SelectByID2("Line1@3D草图1", "EXTSKETCHSEGMENT", x(i) / 2, y(i) / 2, z(i) / 2, True, 1, Nothing, 0) '选择线
boolstatus = Part.Extension.SelectByID2(tdcaotuP, "EXTSKETCHPOINT", x(i), y(i), z(i), True, 0, Nothing, 0) '选择点
x(i) = x(i) / 2
y(i) = y(i) / 2
z(i) = z(i) / 2
boolstatus = Part.Extension.SelectByID2(tdcaotuL, "EXTSKETCHSEGMENT", x(i), y(i), z(i), True, 1, Nothing, 0) '选择线
Dim myRefPlane As Object
Set myRefPlane = Part.FeatureManager.InsertRefPlane(4, 0, 2, 0, 0, 0) '创建基准面
Part.ClearSelection2 True
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2(refplane, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2(refplane, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
Set skSegment = Part.SketchManager.CreateCircle(0#, -0#, 0#, 0.005, 0#, 0#) '画圆
Part.ClearSelection2 True
Set myFeature = Part.FeatureManager.FeatureCut4(True, False, False, 0, 0, 0.02, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, False, True, True, True, True, False, 0, 0, False, False) '切割
Part.SelectionManager.EnableContourSelection = False
Part.ClearSelection2 True


Next

End Sub

以下是一些带孔球壳的效果图,都是创建零件后就可以直接生成的。

1. 直径120mm的圆,孔直径8mm,平均分布180个孔。

 2. 直径120mm的圆,孔直径10mm,平均分布100个孔

  • 3
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值