乐筑天下

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

[编程交流] 用vba更改阴影图

[复制链接]
Grenco

14

主题

40

帖子

26

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
70
发表于 2022-7-6 15:09:15 | 显示全部楼层 |阅读模式
大家好
 
我创建了一个布局，插入了一个drawingborder和一个视口。我还更改了视口中的视图。对于反视口，我还想做一件事；将着色打印设置为“隐藏”。
 
这是vba；
 
  1. Dim newPViewport As AcadPViewport
  2.    Dim center0(0 To 2) As Double
  3.    Dim center1(0 To 2) As Double
  4.    Dim center2(0 To 2) As Double
  5.    Dim center3(0 To 2) As Double
  6.    Dim width As Double
  7.    Dim height As Double
  9.            center0(0) = -110: center0(1) = 115.25: center0(2) = 0
  10.            center1(0) = -110: center1(1) = 229.75: center1(2) = 0
  11.            center2(0) = -310: center2(1) = 115.25: center2(2) = 0
  12.            center3(0) = -310: center3(1) = 229.75: center3(2) = 0
  13.            width = 200
  14.            height = 114.5
  16.    DWG_NameFull = ThisDrawing.Name
  17.    DWG_Name = Replace(DWG_NameFull, ".dwg", "")
  19.    ThisDrawing.ActiveSpace = acPaperSpace
  20.    ThisDrawing.SendCommand ("layout" & vbCr & "r" & vbCr & vbCr & DWG_Name & vbCr)
  22.    Dim Logo As AcadBlockReference
  23.    Dim Kader As AcadBlockReference
  24.    Dim DynProps As Variant
  25.    Dim Variabelen As AcadDynamicBlockReferenceProperty
  26.    Dim I As Integer
  27.    Dim insertionPnt(0 To 2) As Double
  29.    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
  30.    Set Logo = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, "GEALOGO", 1#, 1#, 1#, 0#)
  31.    Set Kader = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, "KADER", 1#, 1#, 1#, 0#)
  32.    If Kader.IsDynamicBlock Then
  33.        DynProps = Kader.GetDynamicBlockProperties
  34.        For I = 0 To UBound(DynProps)
  35.            Set Variabelen = DynProps(I)
  36.            If Variabelen.Value = "A3" Then
  37.                Variabelen.Value = Formaat
  38.                Exit For
  39.            End If
  40.        Next
  41.    End If
  44.    ThisDrawing.ActiveLayout.RefreshPlotDeviceInfo
  45.    ThisDrawing.ActiveLayout.ConfigName = "DWFx ePlot.pc3"
  46.    ThisDrawing.ActiveLayout.StyleSheet = "GEA-kleur-diktes.ctb"
  47.    ThisDrawing.ActiveLayout.PlotType = acExtents
  48.    ThisDrawing.ActiveLayout.CenterPlot = True
  49.    ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
  51.    AutoCAD.Update
  53.    curpapersizes = ThisDrawing.PaperSpace.Layout.GetCanonicalMediaNames()
  54.    ThisDrawing.Regen (acActiveViewport)
  56.    Dim G_sht_frm As String
  57.    G_sht_frm = "UserDefinedMetric (420.00 x 297.00MM)"
  59.    ThisDrawing.ActiveLayout.CanonicalMediaName = G_sht_frm
  60.    ThisDrawing.ActiveLayout.PlotRotation = plotrot
  61.    ThisDrawing.Regen (acAllViewports)
  62.    AutoCAD.ZoomAll
  64.    Dim Layer As AcadLayer
  65.    Set Layer = ThisDrawing.Layers.Add("Viewport")
  66.    Layer.color = acMagenta
  67.    Layer.Plottable = False
  68.    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Viewport")
  70. Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center0, width, height)
  72.            newPViewport.Display (True)
  73.            [color=red]newPViewport.VisualStyle = 3[/color]
  76.            ThisDrawing.MSpace = True
  77.            ThisDrawing.ActivePViewport = newPViewport
  78.            ThisDrawing.SendCommand ("-view" & vbCr & "Right" & vbCr)
  79.            ThisDrawing.SendCommand ("pspace" & vbCr)
  81. ThisDrawing.Regen acAllViewports
  83.    Call VBA.Unload(Me)

 
如您所见，我已将添加的视口视觉样式设置为3（隐藏？）。标准值为1（如图所示？）。在vba中，本地更改为3。但在autoCAD中，着色打印仍然是“显示的”。
 
在autoCAD的VBA帮助下，我无法理解螺旋的含义并将其应用于我的问题。
 
谁能告诉我为什么阴影图没有改变，怎么做？
 
thnx很多
回复

使用道具 举报

Grenco

14

主题

40

帖子

26

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
70
发表于 2022-7-6 15:20:26 | 显示全部楼层
现在我得到了以下代码：
  1. Dim Layer As AcadLayer
  2.    Set Layer = ThisDrawing.Layers.Add("Viewport")
  3.    Layer.color = acMagenta
  4.    Layer.Plottable = False
  5.    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Viewport")
  7.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center0, width, height)
  9.            newPViewport.Display (True)
  10.            newPViewport.VisualStyle = 3
  11.            ThisDrawing.MSpace = True
  12.            ThisDrawing.ActivePViewport = newPViewport
  13.            ThisDrawing.SendCommand ("-view" & vbCr & "Right" & vbCr)
  14.            VBA.DoEvents
  15.            'ThisDrawing.ActiveSpace = acPaperSpace
  16.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center1, width, height)
  17.            newPViewport.Display (True)
  18.            newPViewport.VisualStyle = 3
  19.            ThisDrawing.MSpace = True
  20.            ThisDrawing.ActivePViewport = newPViewport
  21.            ThisDrawing.SendCommand ("-view" & vbCr & "SW" & vbCr)
  22.            VBA.DoEvents
  23.            'ThisDrawing.ActiveSpace = acPaperSpace
  24.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center2, width, height)
  25.            newPViewport.Display (True)
  26.            newPViewport.VisualStyle = 3
  27.            ThisDrawing.MSpace = True
  28.            ThisDrawing.ActivePViewport = newPViewport
  29.            ThisDrawing.SendCommand ("-view" & vbCr & "Front" & vbCr)
  30.            VBA.DoEvents
  31.            'ThisDrawing.ActiveSpace = acPaperSpace
  32.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center3, width, height)
  33.            newPViewport.Display (True)
  34.            newPViewport.VisualStyle = 3
  35.            ThisDrawing.MSpace = True
  36.            ThisDrawing.ActivePViewport = newPViewport
  37.            ThisDrawing.SendCommand ("-view" & vbCr & "Top" & vbCr)
  38.            VBA.DoEvents
  39.            'ThisDrawing.ActiveSpace = acPaperSpace
  40.       ThisDrawing.SendCommand ("pspace" & vbCr)

 
如果我用F8开始代码。它工作完美。如果我使用F5。它跳过了所有命令：“ThisDrawing.SendCommand（“-view”&vbCr&“xxx”&vbCr）”，当他完成后，它会执行这些命令。所以我看到最后一个视口变为“Right”“SW”“Front”和“TOP”
 
怎么会？？我该怎么修？
 
我还有一个问题没有回答
 
thnx！
回复

使用道具 举报

SEANT

10

主题

973

帖子

909

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
118
发表于 2022-7-6 15:33:33 | 显示全部楼层
VBA的“SendCommand”往往有问题——因此最好设置例程：
 
  1. Sub GenViews()
  3. Dim center0(0 To 2) As Double
  4. Dim center1(0 To 2) As Double
  5. Dim center2(0 To 2) As Double
  6. Dim center3(0 To 2) As Double
  7. Dim width As Double
  8. Dim height As Double
  9. Dim Layer As AcadLayer
  10. Dim vDirection(0 To 2) As Double
  12. Dim newPViewport As AcadPViewport
  15.   center0(0) = 110: center0(1) = 115.25: center0(2) = 0
  16.   center1(0) = 110: center1(1) = 229.75: center1(2) = 0
  17.   center2(0) = 310: center2(1) = 115.25: center2(2) = 0
  18.   center3(0) = 310: center3(1) = 229.75: center3(2) = 0
  19.   width = 200
  20.   height = 114.5
  22.    Set Layer = ThisDrawing.Layers.Add("Viewport")
  23.    Layer.color = acMagenta
  24.    Layer.Plottable = False
  25.    ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Viewport")
  27.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center0, width, height)
  28.            newPViewport.ShadePlot = acShadePlotRendered
  30.            vDirection(0) = 1#
  31.            vDirection(1) = 0#
  32.            vDirection(2) = 0#
  33.            newPViewport.Direction = vDirection
  34.            newPViewport.Display True
  35.            ThisDrawing.MSpace = True
  36.            ZoomExtents
  38.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center1, width, height)
  39.            newPViewport.ShadePlot = acShadePlotRendered
  40.            vDirection(0) = -1#
  41.            vDirection(1) = -1#
  42.            vDirection(2) = 1#
  43.            newPViewport.Direction = vDirection
  44.            newPViewport.Display True
  45.            ThisDrawing.MSpace = True
  46.            ZoomExtents
  47.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center2, width, height)
  48.            newPViewport.ShadePlot = acShadePlotRendered
  49.            vDirection(0) = 0#
  50.            vDirection(1) = -1#
  51.            vDirection(2) = 0#
  52.            newPViewport.Direction = vDirection
  53.            newPViewport.Display True
  54.            ThisDrawing.MSpace = True
  55.            ZoomExtents
  56.        Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center3, width, height)
  57.            newPViewport.ShadePlot = acShadePlotRendered
  58.            vDirection(0) = 0#
  59.            vDirection(1) = 0#
  60.            vDirection(2) = 1#
  61.            newPViewport.Direction = vDirection
  62.            newPViewport.Display True
  63.            ThisDrawing.MSpace = True
  64.            ZoomExtents
  65.            ThisDrawing.MSpace = False
  66. End Sub
回复

使用道具 举报

Grenco

14

主题

40

帖子

26

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
70
发表于 2022-7-6 15:42:49 | 显示全部楼层
隐马尔可夫模型。。。我有几分钟的时间再查一下。谢谢
 
毫无疑问，vDirection（0）、（1）和（2）用于将视图设置为TOP、SW、FRONT等？这在数字中是如何工作的？
回复

使用道具 举报

SEANT

10

主题

973

帖子

909

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
118
发表于 2022-7-6 15:55:07 | 显示全部楼层
这些数字的工作方式与AutoCAD的VPOINT命令相同。也就是说，数字vDirection（0）、（1）和（2）分别对应于WCS x、y和z。因此，例如，俯视图可以描述为从与向量0,0,1到0,0,0对齐的视图中查看模型
回复

使用道具 举报

rocheey

1

主题

56

帖子

80

银币

初来乍到

Rank: 1

铜币
1
发表于 2022-7-6 16:04:11 | 显示全部楼层
我现在没有时间复习这段代码，但这似乎与我遇到的问题类似-只是在Modelspace中设置shademode-（我使用sendcommand）你认为这可以将Modelspace用作当前视口吗？
回复

使用道具 举报

Grenco

14

主题

40

帖子

26

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
70
发表于 2022-7-6 16:13:56 | 显示全部楼层
我认为也是这样
 
 
ps。
我使用“newPViewport.ShadePlot=acShadePlotHidden”将其设置为隐藏而非三维隐藏（acShadePlotRendered）
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-4 19:30 , Processed in 0.737637 second(s), 67 queries .

© 2020-2025 乐筑天下

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