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

大鹿

' T8 g9 e6 ~% d3 I: l# T- Z
在某处看到
不知谁有可以分享下
' e7 ?5 s! e. x- f' E

SW2016

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

NC@jiang@nan

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

judyyai

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

阿帕奇

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

文惠

judyyai 发表于 2017-9-13 06:53
% R  J  I% I6 y& X7 d9 x+ S. d6 c是 在玩家論壇 看到的~
4 ]; K( Z  f/ ?3 ?6 S4 ihttp://cax.idv.tw/forum/showthread.php?t=18032&page=3

0 p9 ?  h. P: }, q6 T3 ~- g打不开

+ R- a: W* x; p' W$ N
8 Y- L$ M5 c2 S3 z" h* b

大鹿

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

1. Dim swApp As Object
   
2. Dim Part As Object
   
3. Dim longstatus As Long
   
4. 
   / C. f& k  x, _8 }& [6 l: p
5. Sub main()
   7 r% A3 C, C$ ?$ S
6. Set swApp = Application.SldWorks
   
7. Set Part = swApp.ActiveDoc
   
8. Set swSelMgr = Part.SelectionManager
   
9. Set swSelData = swSelMgr.CreateSelectData
   0 f$ u, L7 [2 u* b6 a! F/ W5 v+ e+ i
10. swSelData.Mark = 1
    3 R8 o9 a& v% M
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)
    
12. Part.ClearSelection
    * Z9 m% f# O) a+ S8 W/ w( Z8 N
13. Bodies = Part.GetBodies2(swSolidBody, True)
    : P, [  a) `6 ]
14. For Each myBody In Bodies
    ! v: b( F2 D1 \2 h. q
15.     myBody.Select2 True, swSelData
    
16. Next
    
17. Set MoveFeature = Part.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)
    
18. Set FeatureData = MoveFeature.GetDefinition()
    ! c$ L! D6 Q5 K: N* K4 h6 E
19. Set PlaneFeature = Part.FirstFeature
    $ [1 m* ?6 N. _* |: i
20. PlaneFeaturename = PlaneFeature.GetTypeName
    - u9 _# u# H3 a, g' n( P7 N
21. While PlaneFeaturename <> "RefPlane"
    5 J# G3 f$ e6 G9 J1 r
22.     Set PlaneFeature = PlaneFeature.GetNextFeature
    8 r! n4 _9 W/ n! G
23.     PlaneFeaturename = PlaneFeature.GetTypeName
    9 s. X7 \& [5 O& m
24. Wend
    
25. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    ; I  ?: _9 T6 H; E7 E  {1 s. g
26. Faces = ThinFeature.GetFaces
    0 Y1 Y" W2 u% |9 }
27. Faces(0).Select4 True, swSelData
    1 X3 {, ?" g3 z" K# }: G
28. FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus
    ( O9 d) k: k! g5 ?
29. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    # G/ B# d0 Z7 b: P. ^9 I
30. Set PlaneFeature = PlaneFeature.GetNextFeature
    * J$ p' @1 H/ h* l- R
31. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    " L8 Z  F5 @" }! _, A' G
32. Faces = ThinFeature.GetFaces
    ( s  C7 e/ {  S, ]( x: ?6 o# i
33. Faces(2).Select4 True, swSelData
    
34. FeatureData.AddMate Nothing, 0, 1, 0, 0, longstatus
    
35. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    4 J; Z' o3 X! q) s) f* G6 _# y
36. Set PlaneFeature = PlaneFeature.GetNextFeature
    
37. Part.Extension.SelectByID2 PlaneFeature.Name, "PLANE", 0, 0, 0, False, 1, Nothing, 0
    
38. Faces = ThinFeature.GetFaces
    
39. Faces(3).Select4 True, swSelData
    8 s% H/ Z# L% y/ N6 b: r* b
40. FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus
    4 d2 }( Z' }3 C7 p
41. MoveFeature.ModifyDefinition FeatureData, Part, Nothing
    0 R3 ~' m- U5 U: X" j
42. Faces = ThinFeature.GetFaces
    
43. Set myBody = Faces(0).GetBody
    
44. myBody.Select2 True, swSelData
    
45. Part.FeatureManager.InsertDeleteBody
    1 n9 b) X  B- g! W2 k. \5 ^
46. Part.ClearSelection
    
47. End Sub

复制代码

. ^6 v5 H$ t* n; k4 J! T5 r
. ?" [4 A9 t9 W

文惠

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

5 R3 f* X# s1 j9 D感谢大鹿哥转贴，代码文字后面隐约还有白色的文字，那些白色的文字也是代码吗？

大鹿

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

4 C+ _" }" A2 ]9 P文惠大大反应奇快, 钦敬!
& O1 a- i) P& G5 v! s. [7 S9 a但好像快过头了, 过去这个论坛的确会在代码后加上污言秽语, 但看来论坛已经做出改善了, 不见这情况了, 见附图反白选取并无什么的白字.
1 |1 I$ i1 `0 h. I- E

文惠

大鹿 发表于 2017-9-13 11:01
* z% {4 z/ ^8 ?# }, U文惠大大反应奇快, 钦敬!
但好像快过头了, 过去这个论坛的确会在代码后加上污言秽语, 但看来论坛已经做 ...

大鹿哥是好人，好人自然人品好！
8 X( ]. A" V# O. K  ~$ Q$ t" P2 T我也是怀疑自己眼花，但反白选择或复制代码后面都跟着一串乱码，只能逐行复制了。
可以肯定是我的人品差，需要深刻反省一下。


& q8 ?% {+ E) J6 i' F$ g

! N+ \: |: F1 ]
' S* M  _: R. D% n1 v! A7 }, o

大鹿

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

9 d& H8 b. u9 d# }' _看到贴图, 知道文惠的难处, 但不清楚是什么原因.

图中的那些白字, 应该不是代码, 俺也不知道是什么.
请教有什么好方法分享代码?
/ k* l0 V) ~' S6 q3 o
只怪论坛中大多数人士单凭直觉发言, 没深究就大放阙词, 久而久之大家都在兜圈说话了,
6 ]  D. J6 E' A0 W. R. X2 h5 G7 _导致俺误会了文惠不严谨, 不好意思.

文惠

大鹿 发表于 2017-9-13 12:15
看到贴图, 知道文惠的难处, 但不清楚是什么原因.

图中的那些白字, 应该不是代码, 俺也不知道是什么.

1 ]: f0 n$ o8 u" W大鹿哥反白选取后面没乱码，同样操作我的却有乱码，难道是浏览器的问题？
  G( x/ e! A+ t& v3 o代码不长，逐行选取也不麻烦，如果代码较长的，我觉得用记事本的txt格式比较好。

大鹿

文惠 发表于 2017-9-13 12:33
/ J  q& L( `, H* [. ~大鹿哥反白选取后面没乱码，同样操作我的却有乱码，难道是浏览器的问题？
, D# T' q/ i& Q" {+ w0 n1 ~* d- U代码不长，逐行选取也不麻烦， ...

俺刚才试过登出后查看本帖, 出现了乱码, 估计只有发帖人才不会出现乱码吧.
! b- G# o0 D6 E, W( q* s; N- E. x2 R
8 ~( q. W7 b1 Y+ G/ g1 ?按文惠吩咐做了个txt文件供各位下载. code.rar (639 Bytes, 下载次数: 108)

2017-9-13 12:48 上传

点击文件名下载附件

文惠

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

文惠

回大鹿哥，成功应用，再次感谢
; L$ j7 w. i+ q) m/ V3 |& R

ryouss

謝謝鹿大分享,

2012版測試成功.


, w5 U. S8 z( Y# E+ M

soso2006

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

NC@jiang@nan

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

NC@jiang@nan

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

judyyai

阿帕奇 发表于 2017-9-13 09:52
& m4 S- e) X& m6 [珠黛，你要是不贴图或录个视频，我等是看不到的

* w. E' P( F8 A% V" U6 Z8 z& p鹿大 已經貼代碼過來~

阿帕奇

大鹿 发表于 2017-9-13 10:38
' O) y1 }8 M/ E, _0 q8 D4 l0 p: m0 H某位麻烦人士已经贴出代码, 如下:
# p1 ?# O6 a# o. u7 v* \3 K- j(俺只不过转贴, 如有任何问题不要找俺, 感谢俺就可以了)

' a+ [3 g$ J% i, o- f: O+ g嗯嗯嗯

阿帕奇

judyyai 发表于 2017-9-14 06:50
# S  H' ]4 W! n8 L鹿大 已經貼代碼過來~

$ W' S8 |+ d4 l7 R) o

OJT521

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

OJT521

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

OJT521

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