在Sset中捕获命名视图乐筑天下 - Powered by Discuz! Archiver

Maverick® 发表于 2008-5-5 10:55:22

在Sset中捕获命名视图

您好，我有一个包含73个命名视图的图形
我正在编写一些代码
需要一些帮助（谢谢鲍勃！）
这部分工作正常[代码它所做的就是抓取图形中的每个blkref（每个视图1个），并使用blkfef为每个BLKEF制作幻灯片。名称为幻灯片名称。然而，我希望能够抓取图形中每个视图的左下角和右上角点，作为每个幻灯片的拾取点。我编写了以下代码，我收到了每个点的提示，视图被缩放到窗口，这对于这一点至关重要，但我无法在sset或中将视图识别为实体类型；我可能做错了什么
我遇到的另一个问题是，通过使用for-each循环，我最终得到了一个幻灯片
我想做的就是提示每个视图，选择我的点，然后让代码为该视图指定blockref名称作为每个幻灯片的名称，然后将视图返回到上一个视图并提示进行下一个选择
此外，对于视图，每个视图都需要恢复（-视图、r等），以便使用冻结（视图）层状态
希望这有意义
谢谢
MDim NView As AcadView
Dim Sset As AcadSelectionSet
Dim Ent As AcadEntity
Dim Pnt1 As Variant
Dim Pnt2 As Variant
Pnt1 = ThisDrawing.Utility.GetPoint(, "Pick First Point")
Pnt2 = ThisDrawing.Utility.GetPoint(, "Pick Second Point")
Set Sset = ThisDrawing.SelectionSets.Add("Sset")
Sset.Select acSelectionSetWindow, Pnt1, Pnt2
ZoomWindow Pnt1, Pnt2
For Each Ent In Sset
If TypeOf Ent Is AcadView Then
strName = NView.Name
ThisDrawing.SendCommand "-view" & vbCr & "r" & vbCr & strName & vbCr
End If
Next Ent

Bryco 发表于 2008-5-5 11:12:23

好的，有了这段代码，我几乎可以得到我需要的了Sub CreateSlides()
On Error Resume Next
ThisDrawing.SelectionSets.Item("Sset").Delete

Dim Sset As AcadSelectionSet
Dim Ent As AcadEntity
Dim BlkRef As AcadBlockReference
Dim NView As AcadView

Dim strName As String
Dim VName As String
Dim sysFileDia As Integer

Dim Pnt1 As Variant
Dim Pnt2 As Variant

Pnt1 = ThisDrawing.Utility.GetPoint(, "Pick First Point")
Pnt2 = ThisDrawing.Utility.GetPoint(, "Pick Second Point")

Set Sset = ThisDrawing.SelectionSets.Add("Sset")
Sset.Select acSelectionSetWindow, Pnt1, Pnt2
ZoomWindow Pnt1, Pnt2

sysFileDia = ThisDrawing.GetVariable("FILEDIA")
ThisDrawing.SetVariable "FILEDIA", 0

For Each Ent In Sset
If TypeOf Ent Is AcadView Then
VName = NView.Name
GoTo Continue
End If
Next Ent

Continue:
For Each Ent In Sset
If TypeOf Ent Is AcadBlockReference Then
Set BlkRef = Ent
strName = BlkRef.Name
ThisDrawing.SendCommand "-view" & vbCr & "r" & vbCr & VName & vbCr
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strName & vbCr
'*****MAKE SURE THE ABOVE FOLDER EXISTS*****
End If
Next Ent
ThisDrawing.SetVariable "FILEDIA", sysFileDia
End Sub
除了它还在问我想恢复什么视图之外；我不知道如何传递，所以当我做vslide时，幻灯片仍然显示视图和构造线，我只想看到blkref
最后，我想将视图恢复到上一个
有人能帮我克服这最后的困境吗
谢谢

Bryco 发表于 2008-5-5 12:51:35

HAND#039；我没有抛弃你，只是很忙
看看，需要添加目录选择和文本文件位
Option Explicit
Sub MLides()
Dim objView As AcadView
Dim objViews As AcadViews
Dim varViewCen As Variant
Dim dblHgt As Double
Dim dblWdt As Double
Dim dblLLPt(0 To 2) As Double
Dim dblURPt(0 To 2) As Double
Dim objEnt As AcadEntity
Dim objBlkRef As AcadBlockReference
Dim objSelSet As AcadSelectionSet
Dim objSelSets As AcadSelectionSets
Dim strSldName As String
Set objViews = ThisDrawing.Views
For Each objView In objViews
varViewCen = objView.Center
dblHgt = objView.Height
dblWdt = objView.Width
dblLLPt(0) = varViewCen(0) - (dblWdt / 2)
dblLLPt(1) = varViewCen(1) - (dblHgt / 2)
dblLLPt(2) = 0
dblURPt(0) = varViewCen(0) + (dblWdt / 2)
dblURPt(1) = varViewCen(1) + (dblHgt / 2)
dblURPt(2) = 0
ZoomWindow dblLLPt, dblURPt

Set objSelSet = ThisDrawing.SelectionSets
For Each objSelSet In objSelSets
If objSelSet.Name = "blkpick" Then
   ThisDrawing.SelectionSets.Item(strSet).Delete
Exit For
End If
Next
Set objSelSet = objSelSets.Add("blkpick")
objSelSet.Select acSelectionSetWindow, dblllpnt, dblurpnt
For Each objEnt In objSelSet
If TypeOf objEnt Is AcadBlockReference Then
   Set objBlkRef = objEnt
   strSldName = objBlkRef.Name
   Exit For
End If
Next objEnt
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strSldName & vbCr
Next objView

Next objView
End Sub

Bryco 发表于 2008-5-5 13:52:34

唐#039；别忘了换文件&nbsp；我只是快速地完成了一些视图，没有测试，然后插入了一些其他内容&nbsp；肯定需要一些清理。

Bryco 发表于 2008-5-5 14:08:12

嘿，鲍勃，我很欣赏这一点，我有一个想法，中心，高度和宽度的方法是门票，但我没有取得进展，所以我试图改变了
无论如何，我可以从您发布的代码中看出，它是；“继续”；工作；太酷了
它正在创建幻灯片，但不在正确的目录中，我现在正在处理这一部分，我只是把filedia代码放进去了
最后，我把zoomprevious放在这里，让我看看我能做些什么

Bryco 发表于 2008-5-5 15:21:33

Bob&#039；我仍然有一个问题，使它正常工作，但我想到一件事，为什么我需要恢复每个视图
如果我只冻结模块开头所有视图所在的层，怎么样？这应该行得通
鲍勃，这就是产生的错误，你知道我哪里出错了吗
此外，我真的不确定我们是否需要写出区块名列表；我可能错了
如果我们使用slidelib从DOS创建幻灯片库，那么我们绝对需要该txt文件，这是目前为止的代码：On Error Resume Next
ThisDrawing.SelectionSets.Item("blkpick").Delete
Dim objView As AcadView
Dim objViews As AcadViews
Dim varViewCen As Variant
Dim dblHgt As Double
Dim dblWdt As Double
Dim dblLLPt(0 To 2) As Double
Dim dblURPt(0 To 2) As Double
Dim objEnt As AcadEntity
Dim objBlkRef As AcadBlockReference
Dim objSelSet As AcadSelectionSet
Dim objSelSets As AcadSelectionSets
Dim intFile As Integer
Dim strFileName As String
Dim strSldName As String
Dim sysFileDia As Integer
sysFileDia = ThisDrawing.GetVariable("FILEDIA")
ThisDrawing.SetVariable "FILEDIA", 0
Set objViews = ThisDrawing.Views
For Each objView In objViews
varViewCen = objView.Center
dblHgt = objView.Height
dblWdt = objView.Width
dblLLPt(0) = varViewCen(0) - (dblWdt / 2)
dblLLPt(1) = varViewCen(1) - (dblHgt / 2)
dblLLPt(2) = 0
dblURPt(0) = varViewCen(0) + (dblWdt / 2)
dblURPt(1) = varViewCen(1) + (dblHgt / 2)
dblURPt(2) = 0
ZoomWindow dblLLPt, dblURPt

Set objSelSets = ThisDrawing.SelectionSets
Set objSelSet = objSelSets.Add("blkpick")

objSelSet.Select acSelectionSetWindow, dblLLPt, dblURPt

For Each objEnt In objSelSet
If TypeOf objEnt Is AcadBlockReference Then
   Set objBlkRef = objEnt
   strSldName = objBlkRef.Name
   Exit For
End If
Next objEnt
ThisDrawing.SendCommand "MSLIDE c:\tempslide\" & strSldName & vbCr
strFileName = "C:\tempslide\" & ThisDrawing.GetVariable("dwgname") & ".lst"
'*****MAKE SURE THIS FOLDER EXISTS*****
   intFile = FreeFile
   Open strFileName For Append As #intFile
   Print #intFile, strSldName & ".sld"
   Close #intFile
Next objView
ThisDrawing.SetVariable "FILEDIA", sysFileDia
ZoomPrevious
谢谢马克

Bryco 发表于 2008-5-5 15:30:52

好的，好消息和坏消息，好消息是我没有正确地看到文件
我修复了这个问题，所有的幻灯片都被创建了。然而，冻结层毕竟不是一个好主意。如果我这样做了，那么会选取哪些点？DUHHH所以，如果你能帮助我在拾取点之前恢复每个视图，那么我会说，这是一个确定的过程，如果我在这里有一些时间，我也会再试一次，你肯定让循环部分工作得很好

Bryco 发表于 2008-5-5 15:36:51

这些点是根据视图的宽度和高度生成的

Bryco 发表于 2008-5-5 16:35:00

是的，我知道，所以你不会&#039；我不认为冻结这层会有任何影响，对吗
当您执行手动mslide和在冻结层的情况下运行此代码时，肯定会有明显的不同
I&#039；我不确定问题出在哪里。我在想，也许我需要去掉代码中的zoomwindow部分
如果我们使用zoomwindow，我们需要在屏幕上挑选一些东西，不是吗；我们不是吗
我很想冻结层并完成，但幻灯片的高度和宽度都不合适
我没有&#039；我真的没有仔细看鲍勃&#039；s代码，我假设数学是正确的

Bryco 发表于 2008-5-5 16:56:25

被冻结的层与任何事情都无关&nbsp；It#039；您保存的视图可能与基于矩形的窗口不同&nbsp；我没有#039；t检查和don#039；我现在没有时间这么做&nbsp；本人&#039；我再试试这个……我&#039；我说过几次，其他人也说过&nbsp；逐行检查代码，看看是什么#039；正在发生&nbsp；当我发布的代码基于视图缩放窗口时；1、；，屏幕看起来是否与手动恢复视图相同
如果去掉代码中的zoomwindow部分，会发生什么&nbsp；提示，mslide对当前显示进行滑动&nbsp；如果你不&#039；t改变当前显示并制作幻灯片，你得到了什么&nbsp；如果你不&#039；再换一次，再做一张幻灯片，你得到了什么？

页: [1] 2

乐筑天下's Archiver

在Sset中捕获命名视图