社区 › Auto Lisp › VBA通过创建多段线

Andresig 发表于 2022-7-6 22:17:27

VBA通过创建多段线

大家好，
 
作为一个好的新手，我正在努力与VBA。。。
 
我有一个对象的选择，所有捕捉，没有间隙之间，现在我需要通过整个周长做一个多段线。。。但是怎么做？
 
在我使用SendCommand“-boundary”但只适用于单个区域之前，现在我必须绘制一条包含多个区域的多段线。
 
任何线索都会帮我很多！！
 
非常感谢。

Andresig 发表于 2022-7-6 22:53:06

这是我的计划。。。。
我选择对象（闭合的LW多段线）并生成区域，然后我将这些区域合并成一个区域，我分解该区域以生成线，我收集线的坐标，然后用检索到的坐标生成一条多段线，但分解的线不符合顺序！！！所以现在我只能忍受。。。
 
以下是我所做的。。。从区域开始。。。
解决这个问题的任何帮助都将是了不起的！
Sub PerimeterLine()
   'To create Regions with the objects
   Dim DifRegs() As AcadObject
   Dim ObjtoConv As AcadEntity
   Dim ActRegion As Variant
   Dim FstRegs As AcadSelectionSet
   Dim FstRegCount As Integer
   Dim FstRegT(1) As Integer
   Dim FstRegV(1) As Variant
   FstRegT(0) = 8: FstRegV(0) = "0"
   FstRegT(1) = 0: FstRegV(1) = "Region"
   ' to combine all regions
   On Error Resume Next
   ThisDrawing.SelectionSets("FstRegs_0").Delete
   On Error GoTo 0
   Set FstRegs = ThisDrawing.SelectionSets.Add("FstRegs_0")
   FstRegs.Select acSelectionSetAll, , , FstRegT, FstRegV
   FstRegCount = FstRegs.Count
   ReDim DifRegs(FstRegCount - 1)
   Dim Thefirst As AcadRegion
   Dim Thesecond As AcadRegion
   For FstObjL = 0 To FstRegCount - 1
       Set DifRegs(FstObjL) = FstRegs.Item(FstObjL)
       If FstObjL <> 0 Then
         Set Thefirst = DifRegs(0)
         Set Thesecond = DifRegs(FstObjL)
         Thefirst.Boolean acUnion, Thesecond
       End If
   Next FstObjL
   Thefirst.Update
   ThisDrawing.Regen acAllViewports
   'explode region in to lines
   Dim ExplodedRegion As Variant
   Dim ExplRegCount As Integer

   ExplodedRegion = Thefirst.Explode

   ExplRegCount = UBound(ExplodedRegion)
   'retrieve coords to make perimeter line
   Dim ExRegL As Integer
   Dim ExRegNumCoords As Integer
   ExRegNumCoords = ((ExplRegCount + 1) * 2) + 1
   Dim ExRegCoords() As Double
   Dim RegLine As AcadLine
   ReDim ExRegCoords(ExRegNumCoords)
   For ExRegL = 0 To ExplRegCount
       Set RegLine = ExplodedRegion(ExRegL)
       ExRegCoords(ExRegL * 2) = RegLine.StartPoint(0)
       ExRegCoords(ExRegL * 2 + 1) = RegLine.StartPoint(1)
       If ExRegL = ExplRegCount Then
         ExRegCoords(ExRegL * 2 + 2) = RegLine.EndPoint(0)
         ExRegCoords(ExRegL * 2 + 3) = RegLine.EndPoint(1)
       End If
   Next ExRegL

   'Make the perimeter line
   Dim PerLine As AcadLWPolyline

   Set PerLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(ExRegCoords)
   PerLine.color = acYellow
End Sub

JoshKing 发表于 2022-7-6 23:47:13

嗨，Andresig，
 
出色的职位。这一点得到了充分的说明和记录，但没有得到任何答复。我一直在寻找这个完全相同的解决方案有一段时间了，所以我也在尝试解决它。如果你找到了解决方案，或者其他人想插话，请告诉我，我也会很感激。
 
谢谢
乔希

查看完整版本: VBA通过创建多段线