移动实体到原点并摆正的宏(13下载)

大鹿

在某处看到
6 Q% ?0 s- w" [" N1 N# h不知谁有可以分享下
# }: U' @* E  b" h
4 W0 \: R) G4 x5 z1 q4 t0 A! H' X/ S

SW2016

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

NC@jiang@nan

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

judyyai

是 在玩家論壇 看到的~
http://cax.idv.tw/forum/showthread.php?t=18032&page=3

阿帕奇

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

文惠

judyyai 发表于 2017-9-13 06:53
# {1 Y3 M1 a7 K/ j( b是 在玩家論壇 看到的~
; p% T2 H* r4 s+ o6 {+ mhttp://cax.idv.tw/forum/showthread.php?t=18032&page=3

打不开

+ w+ s9 g. d- h9 @8 Y: x0 t% Z, ?# k

大鹿

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

1. Dim swApp As Object
   ; q, T3 o  h" e: y" `
2. Dim Part As Object
   
3. Dim longstatus As Long
   8 U' @7 ~( x+ A! Q
4. 
   ) ^. F7 t: w- S! B* Y
5. Sub main()
   
6. Set swApp = Application.SldWorks
   2 y9 }  ~) ~! s' E0 B" p
7. Set Part = swApp.ActiveDoc
   
8. Set swSelMgr = Part.SelectionManager
   
9. Set swSelData = swSelMgr.CreateSelectData
   
10. swSelData.Mark = 1
    
11. 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)
    . F% a4 Q0 p2 ~& q% _& Y3 _: F
12. Part.ClearSelection
    5 ?, k6 x8 l6 q
13. Bodies = Part.GetBodies2(swSolidBody, True)
    8 y- t3 |& n% o/ w# p% e" e6 U/ i
14. For Each myBody In Bodies
    & }& `4 U& h) q, M) a' I- ~& i
15.     myBody.Select2 True, swSelData
    . A# v+ K2 O# j, F6 b( P
16. Next
    + w1 v& q; ^6 H- A! ~0 Y7 ]6 m
17. Set MoveFeature = Part.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)
    0 B' ^0 |2 j* @9 Z2 L4 \
18. Set FeatureData = MoveFeature.GetDefinition()
    # f9 a6 y  x; f+ D4 G/ k- o
19. Set PlaneFeature = Part.FirstFeature
    & ^( ]7 y8 o/ r7 b! z
20. PlaneFeaturename = PlaneFeature.GetTypeName
    
21. While PlaneFeaturename <> "RefPlane"
    7 o, a. f% r2 L4 ]; ]
22.     Set PlaneFeature = PlaneFeature.GetNextFeature
    % R3 d, ], `0 v3 Z2 ?3 D, ^
23.     PlaneFeaturename = PlaneFeature.GetTypeName
    ! {# v! B, l4 [0 U# `
24. Wend
    
25. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
26. Faces = ThinFeature.GetFaces
    $ I7 A" X. G  x  O) V/ q
27. Faces(0).Select4 True, swSelData
    
28. FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus
    ' x, X0 Z/ H" c% Q# r  Y# g, R4 q
29. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    
30. Set PlaneFeature = PlaneFeature.GetNextFeature
    7 ~& }: D0 s5 z+ F* D! l
31. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
32. Faces = ThinFeature.GetFaces
    0 K+ P. w+ H+ g, \9 a
33. Faces(2).Select4 True, swSelData
    ' J( E1 n0 v+ j; |  M! T
34. FeatureData.AddMate Nothing, 0, 1, 0, 0, longstatus
    
35. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    / M' O9 W) d6 ?2 o" ]3 [
36. Set PlaneFeature = PlaneFeature.GetNextFeature
    $ V4 Y" g0 _7 R2 m% [
37. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
38. Faces = ThinFeature.GetFaces
    
39. Faces(3).Select4 True, swSelData
    
40. FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus
    
41. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
      U8 j3 _2 E6 M0 q- S
42. Faces = ThinFeature.GetFaces
    
43. Set myBody = Faces(0).GetBody
    1 c+ ]/ D( M; x
44. myBody.Select2 True, swSelData
    
45. Part.FeatureManager.InsertDeleteBody
    ( C9 G5 z* Q3 i; w5 k/ N* c1 G
46. Part.ClearSelection
    $ @. Q" ?% {9 K
47. End Sub

复制代码

) r3 v2 B* a4 _5 X: q7 j4 o
# q  N- U" ?3 }

文惠

大鹿 发表于 2017-9-13 10:38
某位麻烦人士已经贴出代码, 如下:
(俺只不过转贴, 如有任何问题不要找俺, 感谢俺就可以了)

: J" G1 N! s* `' {感谢大鹿哥转贴，代码文字后面隐约还有白色的文字，那些白色的文字也是代码吗？

大鹿

文惠 发表于 2017-9-13 10:48
感谢大鹿哥转贴，代码文字后面隐约还有白色的文字，那些白色的文字也是代码吗？

! C' N4 ~  {7 j文惠大大反应奇快, 钦敬!
但好像快过头了, 过去这个论坛的确会在代码后加上污言秽语, 但看来论坛已经做出改善了, 不见这情况了, 见附图反白选取并无什么的白字.
, q" N& g9 k) U1 i, g/ m& \

文惠

大鹿 发表于 2017-9-13 11:01
9 J4 \" ?& z8 }文惠大大反应奇快, 钦敬!
1 e9 y8 a3 N6 E5 R但好像快过头了, 过去这个论坛的确会在代码后加上污言秽语, 但看来论坛已经做 ...

大鹿哥是好人，好人自然人品好！
+ H/ d$ ^$ [' r/ ]1 Q- \7 y我也是怀疑自己眼花，但反白选择或复制代码后面都跟着一串乱码，只能逐行复制了。
7 T- ]8 q, t- ?1 j6 ]% E+ Z可以肯定是我的人品差，需要深刻反省一下。
0 B; p$ g- t6 g
) M) T5 @) [, @$ h. u5 E
5 V$ _" p3 W8 ?/ c+ Z7 h" C


6 _0 L6 v% W/ w, s6 M% P1 V

大鹿

文惠 发表于 2017-9-13 11:54
大鹿哥是好人，好人自然人品好！
我也是怀疑自己眼花，但反白选择或复制代码后面都跟着一串乱码，只能逐 ...

; Q! B$ z9 Q1 U, C& T9 j4 N6 A$ D看到贴图, 知道文惠的难处, 但不清楚是什么原因.
' C/ W+ ~, r7 t! Y/ P8 D
图中的那些白字, 应该不是代码, 俺也不知道是什么.
请教有什么好方法分享代码?

3 g, U! w# r: T( `1 T  M只怪论坛中大多数人士单凭直觉发言, 没深究就大放阙词, 久而久之大家都在兜圈说话了,
# ~: t/ B. }% Z/ C导致俺误会了文惠不严谨, 不好意思.

文惠

大鹿 发表于 2017-9-13 12:15
2 a2 \  W: f- S% q- n0 l) u看到贴图, 知道文惠的难处, 但不清楚是什么原因.

; m: |, L" I4 S2 n图中的那些白字, 应该不是代码, 俺也不知道是什么.

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

大鹿

文惠 发表于 2017-9-13 12:33
3 M/ Q3 ]' @  I; u/ s大鹿哥反白选取后面没乱码，同样操作我的却有乱码，难道是浏览器的问题？
代码不长，逐行选取也不麻烦， ...

俺刚才试过登出后查看本帖, 出现了乱码, 估计只有发帖人才不会出现乱码吧.

: j5 K2 y. o5 X4 X: u按文惠吩咐做了个txt文件供各位下载. code.rar (639 Bytes, 下载次数: 112)

2017-9-13 12:48 上传

点击文件名下载附件

文惠

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

文惠

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

ryouss

謝謝鹿大分享,

6 z" L" K3 A3 _. T& t$ s' Q: m2012版測試成功.
: ?3 `' J8 m! }/ E: R
4 |4 U; I' V4 W
; @9 q7 i5 a0 f. I9 o9 _

soso2006

谢谢大鹿哥分享，测试成功！
1 r) @7 Y# Q* d( O有时摆正模型很方便

NC@jiang@nan

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

NC@jiang@nan

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

judyyai

阿帕奇 发表于 2017-9-13 09:52
" d/ L( N% o/ L7 s9 a珠黛，你要是不贴图或录个视频，我等是看不到的

鹿大 已經貼代碼過來~

阿帕奇

大鹿 发表于 2017-9-13 10:38
/ X) i- \' @& u4 z某位麻烦人士已经贴出代码, 如下:
(俺只不过转贴, 如有任何问题不要找俺, 感谢俺就可以了)

嗯嗯嗯

阿帕奇

judyyai 发表于 2017-9-14 06:50
& L8 d, t, |0 `# l4 N鹿大 已經貼代碼過來~

OJT521

哪个能把TXT的私发一个给我不，，下载不了额QQ1436216186谢谢好心人

OJT521

Bodies = Part.GetBodies2(swSolidBody, True)
这一行怎么被说是不支持的属性或方法呢

OJT521

显示 对象变量或WITH变量未设置，，，是为啥咧？