牛人!还用VB6
上回说到“先选择对象再执行命令”，现在牛刀小试一下
4、数值合并计算
Public Sub SumCalc() '数值合并计算
On Error GoTo err1
Dim objSset As AcadSelectionSet, objText As AcadText
Set objSset = getPickFirstSel()
If objSset Is Nothing Then '透明命令，支持执行前选择
SelectLots "SSet", "Text"
Set objSset = ThisDrawing.SelectionSets("SSet")
If objSset.Count = 0 Then Exit Sub
End If
Dim sum, n As Long '和，最大有效位数
For Each objText In objSset
If IsNumeric(objText.TextString) Then
If InStr(objText.TextString, ".") Then
If n < Len(objText.TextString) - InStr(objText.TextString, ".") Then
n = Len(objText.TextString) - InStr(objText.TextString, ".")
End If
End If
sum = sum + CDec(objText.TextString)
Else
ThisDrawing.Utility.Prompt objText.TextString & " 该文本不是纯数字，将不参于计算." & vbCrLf
End If
Next
Dim pt1, FMT As String
If n = 0 Then FMT = "0" Else FMT = "#." & String(n, "0")
pt1 = ThisDrawing.Utility.GetPoint(, "请指定计算结果文本的插入点:")
Set objText = ThisDrawing.ModelSpace.AddText(Format(sum, FMT), pt1, objSset.Item( _
0).Height)
Exit Sub
err1:
Debug.Print Err.Description
Err.Clear
Exit Sub
End Sub
chenshulu 发表于 2014-10-20 18:44 static/image/common/back.gif
你的排图框的源码呢，
已发过二维排序的源码，在哪，
你的排图框的源码呢，还要等多久呢
本帖最后由 zzyong00 于 2015-3-8 18:13 编辑
二、对多段线的认识
多段线俗称pl线，pl线最重要的属性应该是Coordinates ，
Coordinates ：指定对象中每个顶点的坐标。Variant[变体] (双精度数组); 可读写
点数组。LightweightPolyline 对象：变体为 OCS 坐标系统的二维点数组。
另外，对于有圆弧的pl线，用方法GetBulge和SetBulge读取。
pl线的属性或方法中没有能表示每两个点之间长度的，也没有体现每一段的角度（或叫方向），圆弧段，也没有半径等。
现在，我们对其进行扩展，扩展之前，先说一点小知识，就是关于圆弧段的凸度bugle.
凸度是多段线顶点列表中选定顶点和下一顶点之间的圆弧所包含角度的 1/4 的正切值。负的凸度值表示圆弧从选定顶点到下一顶点为顺时针方向。凸度为0 表示直线段，凸度为1表示半圆。
上面的推导就不细说了，初高中数学几何问题！
有了以上各种细节知识（还有不知道的，看帮助），就实现上面说的PL线本身提供功能不足之处。
附带功能演示：
Option Explicit
Const PI = 3.1415926
Public Coordinate_TextHeight As Double '文字高
Public ratio As Double '全局比例
Public Sub ShowPLEachPartDist() '标注多线段各段长度
On Error GoTo ToExit '打开错误陷阱
'------------------------------------------------
Dim objPL As AcadLWPolyline ', basePnt As Variant, blnESC As Boolean
Dim objSset As AcadSelectionSet
Dim objText As AcadText
Dim InsPt As Variant'文本插入点
Dim dblMpt(2) As Double, dbl_NV_Angle As Double '中点，法向量角度
Dim dblDistArr() As Double, dblMidPt() As Double, dblMidPt_NormalVector() As Double, dbl_Bugle_Radius() As Double
Dim i As Long
Dim objDoc As AcadDocument
Set objDoc = ThisDrawing()
SelectLots "MEA~PL~TMP~123", "LWPOLYLINE"
Set objSset = objDoc.SelectionSets("MEA~PL~TMP~123")
If objSset.Count = 0 Then Exit Sub
For Each objPL In objSset
'如果你用，请你下载附件，花费一个币
getPlEachPartInfo objPL, dblDistArr, dblMidPt, dblMidPt_NormalVector, dbl_Bugle_Radius
For i = 0 To UBound(dblDistArr)
dblMpt(0) = dblMidPt(2 * i)
dblMpt(1) = dblMidPt(2 * i + 1)
dbl_NV_Angle = dblMidPt_NormalVector(i)
InsPt = objDoc.Utility.PolarPoint(dblMpt, dbl_NV_Angle, Coordinate_TextHeight * ratio)
If objDoc.ActiveSpace = acPaperSpace Then ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''图纸空间
Set objText = objDoc.PaperSpace.AddText(Format(CStr(Round(dblDistArr(i), 3)), "#.000"), InsPt, Coordinate_TextHeight * ratio)
ElseIf objDoc.ActiveSpace = acModelSpace Then ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''模型空间
Set objText = objDoc.ModelSpace.AddText(Format(CStr(Round(dblDistArr(i), 3)), "#.000"), InsPt, Coordinate_TextHeight * ratio)
End If
objText.Alignment = acAlignmentMiddleCenter
objText.TextAlignmentPoint = InsPt
objText.Rotation = Atn(-1 / Tan(dblMidPt_NormalVector(i)))
objText.Update
Next i
Next
'------------------------------------------------
Exit Sub
'----------------
ToExit:
Resume Next
End Sub
'二点间距离公式
Public Function GetDist2D(ByVal x1 As Double, _
ByVal y1 As Double, _
ByVal x2 As Double, _
ByVal y2 As Double) As Double
GetDist2D = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
End Function
取消原附件的收币，新附件增加凸度圆心坐标
高手,在用VB6,学习一下,谢谢了
向楼主学习.
不错，学习了！
向楼主学习了。
顶！
楼主的免费教程，无私分享令人敬佩！
支持！！
楼主太厉害了