乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: hardwired

布局和列表框以及其他L字。

[复制链接]

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2008-4-1 14:38:26 | 显示全部楼层
不确定我明白你想做什么...你想在列表中选择的布局中进入纸空间吗?如果是这样,当您从列表中选择多个布局时,您会产生问题。
我之前提到过,您可以将标题块过滤到选择集中,并且只对您选择的块进行操作。
如果块存在,此实用程序将返回它,否则它不返回任何内容。在对其进行操作之前,您必须验证块是否确实存在。
  1. Function GetBlockReferenceByLayout(ByVal strBlockName As String, ByVal strLayoutName As String) As AcadBlockReference
  2. 'setup variables
  3. Dim BLCollect As AcadSelectionSet
  4. Dim BlkRef As AcadBlockReference
  5. Dim GCode(1) As Integer
  6. Dim GData(1) As Variant
  7. Dim GPCode As Variant
  8. Dim GPData As Variant
  9. 'filter for selection set
  10. GCode(0) = 0
  11. GData(0) = "Insert"
  12. GCode(1) = 2
  13. GData(1) = strBlockName
  14. GPCode = GCode
  15. GPData = GData
  16. 'create selection set
  17. Set BLCollect = ThisDrawing.SelectionSets.Add("BLOCKREF")
  18. 'add items to selection set
  19. BLCollect.Select acSelectionSetAll, , , GPCode, GPData
  20. 'loop through all items in selection set
  21. For Each BlkRef In BLCollect
  22.     'compare layout name
  23.     If UCase(ThisDrawing.ObjectIdToObject(BlkRef.OwnerID).layout.Name) = UCase(strLayoutName) Then
  24.         'return the reference
  25.         Set GetBlockReferenceByLayout = BlkRef
  26.         Exit For 'exit the 'for' loop since we have the title block. This assumes only a single block in each layout
  27.     End If
  28. Next BlkRef
  29. 'delete the selection set
  30. BLCollect.Delete
  31. 'clear the variable
  32. Set BLCollect = Nothing
  33. End Function

用法应采用以下格式...
  1. Dim blkObject As AcadBlockReference
  2. Set blkObject = GetBlockReferenceByLayout("titleblock", "layout1")
  3. If blkObject = Nothing Then
  4. MsgBox "titleblock was not found in layout1"
  5. Else
  6. 'do other stuff here to blkObject
  7. End If

回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-4-1 15:27:16 | 显示全部楼层
我不想去选择的布局,我已经强制程序在加载时转到paperspace,但现在不需要使用你的代码,但在它之前,它只会转到正常绘图中使用的最后一个布局,这就是为什么我希望当前布局在列表框中突出显示,因为最初程序只做了一个布局(当前布局)。但是与您提供的代码一样,我不必在物理上循环浏览布局,我不再需要它,我需要做的就是在列表框中没有选择任何布局的错误陷阱。
但是为了将来的参考和我自己对知识的渴望,我将如何编写列表框以突出显示当前布局?
出于某种原因,您在列表框中为选择所有内容提供的代码将不再起作用,它只选择一个 - 对代码的唯一更改是重命名控件并将其ListStyle属性更改为1 - fmListStyleOption。
回复

使用道具 举报

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2008-4-1 16:09:40 | 显示全部楼层
multiselect必须设置为frmMultiSelectMulti,否则将失败
要在填充列表框时突出显示当前布局,请检查布局名称是否与当前添加的布局名称匹配。如果是,则高亮显示。请记住,从列表框索引来看,列表框的计数是-1。
  1. With ListBox1
  2. 'populate the listbox
  3. For Each layout In layouts
  4.    .AddItem layout.Name
  5. 'if the current layout matches the layout just added then select it
  6.    If layout.Name = ThisDrawing.ActiveLayout.Name Then
  7.     ListBox.Selected(.ListCount - 1) = True
  8.    End If
  9. Next

回复

使用道具 举报

46

主题

118

帖子

23

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
291
发表于 2008-4-2 05:48:22 | 显示全部楼层
再次感谢..
现在我需要整理这个 全选 复选框.
我注意到,如果我删除您提供的以下代码:
  1. Private Sub LayoutLIST_Change()
  2. ReDim SelectedLayouts(0)
  3. 'loop through the listbox..
  4. For X = 0 To LayoutLIST.ListCount - 1
  5. 'if an item is selected
  6.     If LayoutLIST.Selected(X) = True Then
  7.     'then increment our array and add it to the array..
  8.         ReDim Preserve SelectedLayouts(UBound(SelectedLayouts) + 1)
  9.         SelectedLayouts(UBound(SelectedLayouts)) = LayoutLIST.List(X)
  10.     End If
  11. Next X
  12. End Sub

...从列表框的更改事件中,选择您提供的代码:
  1. Private Sub SelectAll_CHK_Click()
  2. For X = 0 To LayoutLIST.ListCount - 1
  3.     LayoutLIST.Selected(X) = SelectAll_CHK.Value
  4. Next X
  5. End Sub

.....工程。但是,当然,我需要从列表框的更改事件中设置数组,那么除了您最初给出的方式之外,还有其他方法可以选择列表框中的所有条目吗?
这是我在这个程序上的最后一个障碍,好吧,就目前而言,我相信我会找到其他方法来改进它或添加功能,但现在,就是这样。
回复

使用道具 举报

154

主题

1274

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1936
发表于 2008-4-2 08:37:12 | 显示全部楼层
我不明白你想完成什么,但代码如张贴的工作。当您使用SelectAll_CHK_Click事件选择项目时,它将触发LayoutLIST_Change事件,不是一次,而是针对所做的每个更改触发一次。
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-4 23:51 , Processed in 0.549102 second(s), 60 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表