用vba更改阴影图乐筑天下 - Powered by Discuz! Archiver

Grenco 发表于 2022-7-6 15:09:15

用vba更改阴影图

大家好

我创建了一个布局，插入了一个drawingborder和一个视口。我还更改了视口中的视图。对于反视口，我还想做一件事；将着色打印设置为“隐藏”。

这是vba；

Dim newPViewport As AcadPViewport
Dim center0(0 To 2) As Double
Dim center1(0 To 2) As Double
Dim center2(0 To 2) As Double
Dim center3(0 To 2) As Double
Dim width As Double
Dim height As Double

      center0(0) = -110: center0(1) = 115.25: center0(2) = 0
      center1(0) = -110: center1(1) = 229.75: center1(2) = 0
      center2(0) = -310: center2(1) = 115.25: center2(2) = 0
      center3(0) = -310: center3(1) = 229.75: center3(2) = 0
      width = 200
      height = 114.5

DWG_NameFull = ThisDrawing.Name
DWG_Name = Replace(DWG_NameFull, ".dwg", "")

ThisDrawing.ActiveSpace = acPaperSpace
ThisDrawing.SendCommand ("layout" & vbCr & "r" & vbCr & vbCr & DWG_Name & vbCr)

Dim Logo As AcadBlockReference
Dim Kader As AcadBlockReference
Dim DynProps As Variant
Dim Variabelen As AcadDynamicBlockReferenceProperty
Dim I As Integer
Dim insertionPnt(0 To 2) As Double

insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
Set Logo = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, "GEALOGO", 1#, 1#, 1#, 0#)
Set Kader = ThisDrawing.PaperSpace.InsertBlock(insertionPnt, "KADER", 1#, 1#, 1#, 0#)
If Kader.IsDynamicBlock Then
   DynProps = Kader.GetDynamicBlockProperties
   For I = 0 To UBound(DynProps)
      Set Variabelen = DynProps(I)
      If Variabelen.Value = "A3" Then
            Variabelen.Value = Formaat
            Exit For
      End If
   Next
End If

ThisDrawing.ActiveLayout.RefreshPlotDeviceInfo
ThisDrawing.ActiveLayout.ConfigName = "DWFx ePlot.pc3"
ThisDrawing.ActiveLayout.StyleSheet = "GEA-kleur-diktes.ctb"
ThisDrawing.ActiveLayout.PlotType = acExtents
ThisDrawing.ActiveLayout.CenterPlot = True
ThisDrawing.ActiveLayout.StandardScale = acScaleToFit

AutoCAD.Update

curpapersizes = ThisDrawing.PaperSpace.Layout.GetCanonicalMediaNames()
ThisDrawing.Regen (acActiveViewport)

Dim G_sht_frm As String
G_sht_frm = "UserDefinedMetric (420.00 x 297.00MM)"

ThisDrawing.ActiveLayout.CanonicalMediaName = G_sht_frm
ThisDrawing.ActiveLayout.PlotRotation = plotrot
ThisDrawing.Regen (acAllViewports)
AutoCAD.ZoomAll

Dim Layer As AcadLayer
Set Layer = ThisDrawing.Layers.Add("Viewport")
Layer.color = acMagenta
Layer.Plottable = False
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Viewport")

Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center0, width, height)

      newPViewport.Display (True)
      newPViewport.VisualStyle = 3

      ThisDrawing.MSpace = True
      ThisDrawing.ActivePViewport = newPViewport
      ThisDrawing.SendCommand ("-view" & vbCr & "Right" & vbCr)
      ThisDrawing.SendCommand ("pspace" & vbCr)

ThisDrawing.Regen acAllViewports

Call VBA.Unload(Me)

如您所见，我已将添加的视口视觉样式设置为3（隐藏？）。标准值为1（如图所示？）。在vba中，本地更改为3。但在autoCAD中，着色打印仍然是“显示的”。

在autoCAD的VBA帮助下，我无法理解螺旋的含义并将其应用于我的问题。

谁能告诉我为什么阴影图没有改变，怎么做？

thnx很多

Grenco 发表于 2022-7-6 15:20:26

现在我得到了以下代码：
Dim Layer As AcadLayer
Set Layer = ThisDrawing.Layers.Add("Viewport")
Layer.color = acMagenta
Layer.Plottable = False
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Viewport")

   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center0, width, height)

      newPViewport.Display (True)
      newPViewport.VisualStyle = 3
      ThisDrawing.MSpace = True
      ThisDrawing.ActivePViewport = newPViewport
      ThisDrawing.SendCommand ("-view" & vbCr & "Right" & vbCr)
      VBA.DoEvents
      'ThisDrawing.ActiveSpace = acPaperSpace
   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center1, width, height)
      newPViewport.Display (True)
      newPViewport.VisualStyle = 3
      ThisDrawing.MSpace = True
      ThisDrawing.ActivePViewport = newPViewport
      ThisDrawing.SendCommand ("-view" & vbCr & "SW" & vbCr)
      VBA.DoEvents
      'ThisDrawing.ActiveSpace = acPaperSpace
   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center2, width, height)
      newPViewport.Display (True)
      newPViewport.VisualStyle = 3
      ThisDrawing.MSpace = True
      ThisDrawing.ActivePViewport = newPViewport
      ThisDrawing.SendCommand ("-view" & vbCr & "Front" & vbCr)
      VBA.DoEvents
      'ThisDrawing.ActiveSpace = acPaperSpace
   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center3, width, height)
      newPViewport.Display (True)
      newPViewport.VisualStyle = 3
      ThisDrawing.MSpace = True
      ThisDrawing.ActivePViewport = newPViewport
      ThisDrawing.SendCommand ("-view" & vbCr & "Top" & vbCr)
      VBA.DoEvents
      'ThisDrawing.ActiveSpace = acPaperSpace
   ThisDrawing.SendCommand ("pspace" & vbCr)

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

怎么会？？我该怎么修？

我还有一个问题没有回答

thnx！

SEANT 发表于 2022-7-6 15:33:33

VBA的“SendCommand”往往有问题——因此最好设置例程：

Sub GenViews()

Dim center0(0 To 2) As Double
Dim center1(0 To 2) As Double
Dim center2(0 To 2) As Double
Dim center3(0 To 2) As Double
Dim width As Double
Dim height As Double
Dim Layer As AcadLayer
Dim vDirection(0 To 2) As Double

Dim newPViewport As AcadPViewport

center0(0) = 110: center0(1) = 115.25: center0(2) = 0
center1(0) = 110: center1(1) = 229.75: center1(2) = 0
center2(0) = 310: center2(1) = 115.25: center2(2) = 0
center3(0) = 310: center3(1) = 229.75: center3(2) = 0
width = 200
height = 114.5

Set Layer = ThisDrawing.Layers.Add("Viewport")
Layer.color = acMagenta
Layer.Plottable = False
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("Viewport")

   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center0, width, height)
      newPViewport.ShadePlot = acShadePlotRendered

      vDirection(0) = 1#
      vDirection(1) = 0#
      vDirection(2) = 0#
      newPViewport.Direction = vDirection
      newPViewport.Display True
      ThisDrawing.MSpace = True
      ZoomExtents

   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center1, width, height)
      newPViewport.ShadePlot = acShadePlotRendered
      vDirection(0) = -1#
      vDirection(1) = -1#
      vDirection(2) = 1#
      newPViewport.Direction = vDirection
      newPViewport.Display True
      ThisDrawing.MSpace = True
      ZoomExtents
   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center2, width, height)
      newPViewport.ShadePlot = acShadePlotRendered
      vDirection(0) = 0#
      vDirection(1) = -1#
      vDirection(2) = 0#
      newPViewport.Direction = vDirection
      newPViewport.Display True
      ThisDrawing.MSpace = True
      ZoomExtents
   Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(center3, width, height)
      newPViewport.ShadePlot = acShadePlotRendered
      vDirection(0) = 0#
      vDirection(1) = 0#
      vDirection(2) = 1#
      newPViewport.Direction = vDirection
      newPViewport.Display True
      ThisDrawing.MSpace = True
      ZoomExtents
      ThisDrawing.MSpace = False
End Sub

Grenco 发表于 2022-7-6 15:42:49

隐马尔可夫模型。。。我有几分钟的时间再查一下。谢谢

毫无疑问，vDirection（0）、（1）和（2）用于将视图设置为TOP、SW、FRONT等？这在数字中是如何工作的？

SEANT 发表于 2022-7-6 15:55:07

这些数字的工作方式与AutoCAD的VPOINT命令相同。也就是说，数字vDirection（0）、（1）和（2）分别对应于WCS x、y和z。因此，例如，俯视图可以描述为从与向量0,0,1到0,0,0对齐的视图中查看模型

rocheey 发表于 2022-7-6 16:04:11

我现在没有时间复习这段代码，但这似乎与我遇到的问题类似-只是在Modelspace中设置shademode-（我使用sendcommand）你认为这可以将Modelspace用作当前视口吗？

Grenco 发表于 2022-7-6 16:13:56

我认为也是这样

ps。
我使用“newPViewport.ShadePlot=acShadePlotHidden”将其设置为隐藏而非三维隐藏（acShadePlotRendered）

页: [1]

乐筑天下's Archiver

用vba更改阴影图