移动实体到原点并摆正的宏

ljql2ah

   经典图书

在某处看到
不知谁有可以分享下

jiyang315

没有啊，这种情况我只晓得用移动/复制

davisw123

   经典图书

这相当于要修改草图基准面了吧，而且后续草图基准面要在已存在的实体上，要不然特征越多越复杂了。

zzd1015

珠黛，你要是不贴图或录个视频，我等是看不到的

水冰月

   经典案例图书

某位麻烦人士已经贴出代码, 如下:
(俺只不过转贴, 如有任何问题不要找俺, 感谢俺就可以了)

1. Dim swApp As Object
   
2. Dim Part As Object
   
3. Dim longstatus As Long
   
4. Sub main()
   
5. Set swApp = Application.SldWorks
   
6. Set Part = swApp.ActiveDoc
   
7. Set swSelMgr = Part.SelectionManager
   
8. Set swSelData = swSelMgr.CreateSelectData
   
9. swSelData.Mark = 1
   
10. Set ThinFeature = Part.FeatureManager.FeatureExtrusionThin2(True, False, False, 0, 0, 0.005, 0.005, False, False, False, False, 0, 0, False, False, False, False, False, 0.005, 0.005, 0.005, 0, 0, False, 0.005, True, True, 0, 0, False)
    
11. Part.ClearSelection
    
12. Bodies = Part.GetBodies2(swSolidBody, True)
    
13. For Each myBody In Bodies
    
14.     myBody.Select2 True, swSelData
    
15. Next
    
16. Set MoveFeature = Part.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)
    
17. Set FeatureData = MoveFeature.GetDefinition()
    
18. Set PlaneFeature = Part.FirstFeature
    
19. PlaneFeaturename = PlaneFeature.GetTypeName
    
20. While PlaneFeaturename <> "RefPlane"
    
21.     Set PlaneFeature = PlaneFeature.GetNextFeature
    
22.     PlaneFeaturename = PlaneFeature.GetTypeName
    
23. Wend
    
24. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
25. Faces = ThinFeature.GetFaces
    
26. Faces(0).Select4 True, swSelData
    
27. FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus
    
28. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    
29. Set PlaneFeature = PlaneFeature.GetNextFeature
    
30. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
31. Faces = ThinFeature.GetFaces
    
32. Faces(2).Select4 True, swSelData
    
33. FeatureData.AddMate Nothing, 0, 1, 0, 0, longstatus
    
34. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    
35. Set PlaneFeature = PlaneFeature.GetNextFeature
    
36. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
37. Faces = ThinFeature.GetFaces
    
38. Faces(3).Select4 True, swSelData
    
39. FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus
    
40. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    
41. Faces = ThinFeature.GetFaces
    
42. Set myBody = Faces(0).GetBody
    
43. myBody.Select2 True, swSelData
    
44. Part.FeatureManager.InsertDeleteBody
    
45. Part.ClearSelection
    
46. End Sub
复制代码

CAOCHAYDF

感谢版大哥转贴，代码文字后面隐约还有白色的文字，那些白色的文字也是代码吗？

sherry_liuyue

   经典案例图书

文惠大大反应奇快, 钦敬!
但好像快过头了, 过去这个论坛的确会在代码后加上污言秽语, 但看来论坛已经做出改善了, 不见这情况了, 见附图反白选取并无什么的白字.

kongxiangcui

版大哥是好人，好人自然人品好！
我也是怀疑自己眼花，但反白选择或复制代码后面都跟着一串乱码，只能逐行复制了。
可以肯定是我的人品差，需要深刻反省一下。

tiankong00

看到贴图, 知道文惠的难处, 但不清楚是什么原因.
图中的那些白字, 应该不是代码, 俺也不知道是什么.
请教有什么好方法分享代码?
只怪论坛中大多数人士单凭直觉发言, 没深究就大放阙词, 久而久之大家都在兜圈说话了,
导致俺误会了文惠不严谨, 不好意思.

huolieer

   经典图书

版大哥反白选取后面没乱码，同样操作我的却有乱码，难道是浏览器的问题？
代码不长，逐行选取也不麻烦，如果代码较长的，我觉得用记事本的txt格式比较好。

maojun123

俺刚才试过登出后查看本帖, 出现了乱码, 估计只有发帖人才不会出现乱码吧.
按文惠吩咐做了个txt文件供各位下载.
code.rar (639 Bytes, 下载次数: 119)

2018-3-31 09:33 上传

点击文件名下载附件
下载积分: 金币 -1

iagss258

感谢版大哥的贴心分享，等忙完手头的工作再试用一下。

xboy1937

回版大哥，成功应用，再次感谢

ds0001

謝謝工程师分享,
2012版測試成功.

feifan126

加入QQ群
参与讨论和学习

或扫描二维码加入

谢谢版大哥分享，测试成功！
有时摆正模型很方便

renjiwei

   经典案例图书

我试试，看看对多实体的效果怎样

shiwuming

加入QQ群
参与讨论和学习

或扫描二维码加入

哦哦，原来它是把已经有的实体复制移动到原点。那这样确实是不存在是不是多实体的问题了，特征树上的每个特征都选上就行了。

anyeliu

   经典案例图书

工程师 已經貼代碼過來~

yjf888

嗯嗯嗯

huan312737