中心线总是在阴影1还是2上
您有连续的图形1到28，但似乎没有一个图层对应于图形编号
红线似乎与轧辊直径有关，但顶部红线和底部红线似乎有不同的数字。 好的，我明白了，我需要再解释一下。我上传的图纸包含2-1/2”的不同场景；迪亚。我相信是管子。第一组包含使用从对话框右上角选取的自定义冲压的部件。然后我做了一个空闲端，一个中心支撑，然后每个驱动端的细节。然后我做了一个包含一些附件的绘图，比如面板/瓷砖支架。然后，我为双阴影组件绘制了相同的空闲中心和驱动器细节。然后，我重复这个过程，手动冲压电子1/2，然后是电子延伸冲压。我还有几张画再画几张图，上面有其他管子的场景，但遵循相同的逻辑。这有什么意义吗？如果我有一个双阴影组件，一个中心线将位于shade1层，另一个位于shade2层。青色卷线也是如此。让我知道这对任何人来说是否有意义，因为我整天都在画这些东西，所以这些术语对我来说很熟悉。 第一次变更；DrawCLines子元素包含一个提供层名称的字符串参数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 然后使用Find查找所有出现的drawcline，并添加其中一个；阴影1“；或；阴影2“；在适当的情况下
If ThisDrawing.IsSingleShade Then
If ThisDrawing.IsCS Then' center support single shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Translate(0) = CLP2(0)
Translate(1) = CLP2(1)
Translate(2) = CLP2(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Else ' end condition single shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP2(0)
Translate(4) = CLP2(1)
Translate(5) = CLP2(2)
DrawCLines Translate, "Shade1"
End If
Else
If ThisDrawing.IsCS Then ' center support double shade
Translate(0) = CLP1(0)
Translate(1) = CLP1(1)
Translate(2) = CLP1(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Translate(0) = CLP2(0)
Translate(1) = CLP2(1)
Translate(2) = CLP2(2)
Translate(3) = CLP3(0)
Translate(4) = CLP3(1)
Translate(5) = CLP3(2)
DrawCLines Translate, "Shade1"
Translate(0) = CLP4(0)
Translate(1) = CLP4(1)
Translate(2) = CLP4(2)
Translate(3) = CLP6(0)
Translate(4) = CLP6(1)
Translate(5) = CLP6(2)
DrawCLines Translate, "Shade2"
Translate(0) = CLP5(0)
Translate(1) = CLP5(1)
Translate(2) = CLP5(2)
Translate(3) = CLP6(0)
Translate(4) = CLP6(1)
Translate(5) = CLP6(2)
DrawCLines Translate, "Shade2"
Else ' end condition double shade
code]
我只讨厌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
Bryco首先感谢你的帮助。我加入了新的sub并添加了翻译。当我现在运行它时，在我选择了我的点之后，我得到了一个执行错误。我没有包括你第二篇文章中的代码，因为我认为这更像是对应该如何完成的建议，对吗
页:
1
[2]