Private Sub DrawCLines(Trans As Variant, sLayer As String)
Dim Cline1(0 To 0) As AcadObject
Dim lclStartPoint As Variant
Dim lclEndPoint As Variant
Set Cline1(0) = ActSpc.AddPolyline(Trans)
Cline1(0).Layer = sLayer
Cline1(0).color = acGreen
Cline1(0).Linetype = "CENTER"
End Sub
然后使用查找查找所有出现的DrawCLines
并在适当的情况下添加“Shade1”或“Shade2”。
我个人讨厌2dPolylines，显示的代码不是vba的良好介绍。
如果一个人正在制作大量的极点，那么它们也可以直接传递给子，而不是在代码上加倍
Dim Ang As Double
Ang = MainAngle - (Pi / 2)
CLP1 = TDU.PolarPoint(M1, Ang, D1)
CLP2 = TDU.PolarPoint(M2, Ang, D1)
CLP3 = TDU.PolarPoint(M3, Ang, D1)
CLP4 = TDU.PolarPoint(M1, Ang, D2)
CLP5 = TDU.PolarPoint(M2, Ang, D2)
CLP6 = TDU.PolarPoint(M3, Ang, D2)
If ThisDrawing.IsSingleShade Then
If ThisDrawing.IsCS Then' center support single shade
DrawCLines CLP1, CLP3, "Shade1"
DrawCLines CLP2, CLP3, "Shade1"
Else ' end condition single shade
DrawCLines CLP1, CLP2, "Shade1"
End If
Else
If ThisDrawing.IsCS Then ' center support double shade
DrawCLines CLP1, CLP3, "Shade1"
DrawCLines CLP2, CLP3, "Shade1"
DrawCLines CLP4, CLP6, "Shade2"
DrawCLines CLP5, CLP6, "Shade2"
Else ' end condition double shade
DrawCLines CLP1, CLP6, "Shade1"
DrawCLines CLP4, CLP5, "Shade2"
End If
End If
Private Sub DrawCLines(StartPoint As Variant, EndPoint As Variant, sLayer As String)
Dim Cline1As AcadLWPolyline
Dim Pts(3) As Double
Pts(0) = StartPoint(0): Pts(1) = StartPoint(1)
Pts(2) = EndPoint(0): Pts(3) = EndPoint(1)
Set Cline1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(Pts)
Cline1.Layer = sLayer
Cline1.color = acGreen
Cline1.Linetype = "CENTER"
End Sub
首先谢谢你的帮助。我装上了新的潜艇，并增加了翻译。当我在选择了点之后运行它，我得到了一个执行错误。我没有包括你第二篇文章中的代码，因为我认为它更多的是建议应该如何做，这是正确的吗
页:
1
[2]