PowerSHAPE中的视角投影外挂，附加源代码

xsh2003 · 发表于 2009-2-8 18:40:11

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

‘--------------------------------------------------------------------源代码
Private Sub Command1_Click()
Dim A As Long
ps.StoreData "SELECTION.NUMBER"
If ps.StoredData = 0 Then
MsgBox "未选取投影所需物件，请再次选取！", vbCritical, "错误"
   Exit Sub
End If
If Combo1.Text = "NO" Then
ps.Execute "PRINCIPALPLANE XY"
ps.Execute "create curve PROJECT"
ps.Execute "THRU"
ps.Execute "ACCEPT"
ps.Execute "select clearlist"
ps.Execute "add Workplane 'XSH'"
ps.Execute "Delete"
End
ElseIf Combo1.Text = "YES" Then
ps.Execute "PRINCIPALPLANE XY"
ps.Execute "create curve PROJECT"
ps.Execute "THRU"
ps.Execute "ACCEPT"
End
End If
End Sub
Private Sub Command2_Click()
  ps.Execute "add Workplane 'XSH'"
  ps.Execute "MODIFY"
  ps.Execute "VIEWALIGN"
  ps.Execute "ACCEPT"
  ps.Execute "SELECT CLEARLIST"
End Sub
Private Sub Command3_Click()
ps.Execute "add Workplane 'XSH'"
ps.Execute "Delete"
End
End Sub
Private Sub Form_Load() 'This EVENT PROCEDURE occurs when the form is first loaded.
Dim ActiveIndex As Long
Dim NoOfWorkplanes As Integer
ps.Connect
If ps.Connected = False Then
  MsgBox "请打开PowerSHAPE！", vbCritical, "连接错误！"
  Else
  ps.Execute "create workplane"
  ps.Execute "SINGLE"
  ps.Execute "0 0 0"
  ps.Execute "ACTIVATE_WORKPLANE XSH"
  ps.Execute "MODIFY"
  ps.Execute "VIEWALIGN"
  ps.Execute "ACCEPT"
  ps.Execute "SELECT CLEARLIST"
  End If
Combo1.AddItem "NO"
Combo1.AddItem "YES"
End sub

[ 本帖最后由 xsh2003 于 2009-2-8 18:51 编辑 ]

sidong · 发表于 2009-2-9 22:27:46

收下了谢谢

zwz9 · 发表于 2011-1-24 19:01:35

下来看看在实践中怎么样

zwz9 · 发表于 2011-1-24 19:04:32

没有啊确少控件

adelbo · 发表于 2012-6-13 17:48:54

楼主，你这个外挂是用什么语言什么软件来写的？

xsh2003 · 发表于 2012-7-3 20:38:50

VB 6.0这已经是很久以前的代码了,老旧了

		自动登录	找回密码
密码			注册

通知

[原创] PowerSHAPE中的视角投影外挂，附加源代码

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分

浏览过的版块