016集——n等分cad多段线、弧、圆等——vba实现

本文主要是介绍016集——n等分cad多段线、弧、圆等——vba实现，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

        cad命令行输入“div”选择图元后可n等分图元，若图中有大量图元需要n等分，这时可借助vba一键实现。

        代码逻辑框架为：通过创建句柄函数来选择实体，通过sendcommand函数向命令行输入命令。

先来个小程序练练手：在屏幕上指定两点划线，然后等分该线段。

Sub n等分cad多段线()
'2024年3月7日16:49:46 by qq:443440204Dim startPoint As VariantDim endPoint As VariantDim pp As Variant ''必须为变体变量，否则数组不能赋值Dim lineObj As AcadEntityDim numSegments As IntegerDim lineHandle As StringDim divCommand As StringnumSegments = 20 ' 获取要等分的段数startPoint = thisdrawing.Utility.GetPoint(, "Enter start point: ")endPoint = thisdrawing.Utility.GetPoint(, "Enter end point: ")i1 = UBound(startPoint) - 1ReDim pp(i1) As Double ''只能为double,否则划线函数报错For i = 0 To UBound(startPoint) - 1pp(i) = startPoint(i)Nextj = UBound(pp)i2 = j + UBound(endPoint)ReDim Preserve pp(i2) As DoubleFor i = 0 To UBound(endPoint) - 1j = j + 1pp(j) = endPoint(i)Next' 画线Set lineObj = thisdrawing.ModelSpace.AddLightWeightPolyline(pp)' 获取线的LISP句柄lineHandle = obj2lsp(lineObj)' 获取要插入的段数'numSegments = thisdrawing.Utility.GetInteger("Enter number of segments: ")'构建DIV命令的LISP字符串'divCommand = "_div " & lineHandle & vbCr & numSegmentsthisdrawing.SendCommand "_div "thisdrawing.SendCommand lineHandle & vbCr & numSegments & vbCr
MsgBox "已完成", , "版权@qq:443440204"
End Sub
Function obj2lsp(myobj As AcadEntity) As StringDim objHandle As StringobjHandle = myobj.Handleobj2lsp = "(handent " & Chr(34) & objHandle & Chr(34) & ")"
End Function

         由下图可见，线画出来了，n等分的点也出来了。

        继续升级一下代码功能，选择图中所有多段线、二维多线段、弧、圆、样条曲线、 直线等，然后n等分：

Sub n等分cad多段线_弧_圆等()
'2024年3月7日16:49:46 by qq:443440204
Dim ent As AcadEntity
Dim numSegments As Integer
Dim lineHandle As String
Dim divCommand As String
Dim fy(0) As Integer, fd(0) As Variant
fy(0) = 0: fd(0) = "point"
Set sel = creatsel()
sel.Select acSelectionSetAll, , , fy, fd
Dim pt As AcadEntity
For Each pt In selpt.Delete '等分之前先把图中所有点删除
Next' 获取要插入的段数
numSegments = 12
On Error Resume Next
fy(0) = 0: fd(0) = "circle,*line,arc"
Set sel = creatsel()
sel.Select acSelectionSetAll, , , fy, fd
For Each ent In sel' 获取线的LISP句柄lineHandle = obj2lsp(ent)' 获取要插入的段数' numSegments = thisdrawing.Utility.GetInteger("Enter number of segments: ")thisdrawing.SendCommand "_div "thisdrawing.SendCommand lineHandle & vbCr & numSegments & vbCr
Next
MsgBox "已完成", , "版权@qq:443440204"
End Sub
Function obj2lsp(myobj As AcadEntity) As StringDim objHandle As StringobjHandle = myobj.Handleobj2lsp = "(handent " & Chr(34) & objHandle & Chr(34) & ")"
End Function
Public Function creatsel() As AcadSelectionSet
On Error Resume Next
Dim sel As AcadSelectionSetIf Not IsNull(thisdrawing.SelectionSets.Item("mysel")) ThenSet creatsel = thisdrawing.SelectionSets.Item("mysel")creatsel.Delete
''如果图中有名为"mysel"的选择集，那么把这个选择集放入sel中，然后删除这个选择集End If
''如果图中没有"mysel"，那么新建一个名为"mysel"的选择集，赋给sel这个对象
Set creatsel = thisdrawing.SelectionSets.Add("mysel")
End Function

见下图，所有图元已12等分。

原创代码，以上代码版权归本博所有，引用请注明连接 。

这篇关于016集——n等分cad多段线、弧、圆等——vba实现的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！

---