在Sset中捕获命名视图

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

嗨
我有一个大约73个命名视图的绘图。
我正在编写一些代码；
在一些帮助下(谢谢鲍勃！)
这部分工作正常代码0]
它所做的只是抓取绘图中的每个blkref(每个视图1个),并使用blk ref . name作为幻灯片名称，为每个视图制作一个幻灯片
但是，我希望能够抓取绘图中每个视图的左下角点和右上角点，作为每个幻灯片的选取点。我写了下面的代码，我得到了每个点的提示，视图被缩放到窗口，这是非常重要的，但我不能让视图被识别为sset中的实体类型，或者我可能做错了什么。
我遇到的另一个问题是，通过使用for each循环，我以幻灯片放映结束。
我想做的就是提示每个视图，选择我的点，然后让代码为该视图分配blockref名称作为每个幻灯片的名称，然后将视图返回到上一个视图并提示下一个选择。
此外，对于视图，每个视图都需要恢复(-view，r等)，以便使用冻结的(视图)图层状态。
希望这有意义？
谢谢！M

copy

Dim 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

好吧，
有了这个代码，我几乎拥有了我需要的东西

copy

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。
最后，我想把观点恢复到以前的水平。
谁能帮我克服这最后的蜷缩？
谢谢
M

hendie · 发表于 2008-5-5 12:51:35

没有抛弃你，只是很忙。
看看这个，需要添加目录选择和文本文件位。

copy

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

别忘了更改文件。我只是快速地完成了视图，没有测试阶段，然后将其他东西的一部分放了进去。肯定会需要一些清理。

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

嘿Bob
我很感激
我有一个想法，中心、高度和宽度方法是门票，但我没有取得进展，所以我试图改变。
无论如何，我可以从尝试您发布的代码中看出它“将”开始工作；这太酷了！
它正在创建幻灯片，但不是在正确的目录中，我现在正在处理该部分，我刚刚将文件代码放入其中。
此外，在最后，我只是将zoomago
所以，让我看看我可以在这里做什么
马克

hendie · 发表于 2008-5-5 15:21:33

鲍勃
我仍然遇到问题，使这项工作正常工作，但我想到了一件事
为什么我需要恢复每个视图？
如果我只是冻结模块开头所有视图所在的图层，该怎么办？呵呵
呵
鲍勃，这是正在生成的错误
你看到我哪里出错了吗？
另外，我不太确定我们甚至需要写出块名列表;我可能是错的。
如果我们使用slidelib从DOS创建一个幻灯片库，那么我们绝对需要该txt文件
这是到目前为止的代码：

copy

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

谢谢
Mark

hendie · 发表于 2008-5-5 15:30:52

好的
好消息和坏消息
好消息是我没有正确地看到filedia。
我修复了这个问题，所有的幻灯片都创建好了
但是，冻结图层毕竟不是一个好主意
如果我这样做了，那么会选择哪些点呢？DUHHH
所以，如果你能帮助我在选择点之前恢复每个视图，那么我会说，这是一个明确的目标
如果我有时间，我也会再试一次
你肯定得到了循环部分工作完美的标志

hendie · 发表于 2008-5-5 15:36:51

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

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

是的，我知道＜br＞所以，你不会认为冻结该层会产生任何影响，对吗
当您执行手动mslide和在冻结层的情况下运行此代码时，肯定会有明显的差异
我不确定问题出在哪里。
我在想，可能是我需要去掉代码中的zoomwindow部分
我很想冻结图层并完成，但幻灯片没有给出高度和宽度大小
我没有仔细查看Bob的代码，我假设数学是正确的
标记

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

被冻结的图层与任何事情都无关。您保存的视图可能与基于矩形的窗口不同。我还没有检查，现在也没有时间这样做。我会再试一次...我已经说过好几次了，其他人也说过。逐行逐行浏览代码，查看发生的情况。当我发布的代码根据视图“1”缩放窗口时，屏幕看起来是否与手动还原视图相同？
如果您删除了代码的缩放窗口部分，会发生什么？提示，mslide 制作当前显示的幻灯片。如果不更改当前显示并制作幻灯片，您将获得什么？如果您不再更改它，并制作另一张幻灯片，您将获得什么？

在Sset中捕获命名视图

发表回复

精选推荐