如何实现动态面积呢

brainstorm · 发表于 2020-8-23 00:03:55

可以用overrule

mycad · 发表于 2020-8-27 17:25:05

520kim · 发表于 2023-12-3 21:29:34

好东西，求LISP源码

tiancao100 · 发表于 2023-12-4 10:53:12

分享一个 Overrule的，VB.net源码

'建筑面积
Namespace ZtJZMJ
Public Class JZMJ_Overule
Dim NewRule As New JZMJ
<CommandMethod("ZtJZMJStart")> _
Public Sub OveruleStart()
On Error Resume Next
ACADFunctions.CreateLayer("Zt_全建筑面积标注", 2, "continuous", LineWeight.ByLineWeightDefault, False, False) '不可打印
ACADFunctions.CreateLayer("Zt_半建筑面积标注", 2, "continuous", LineWeight.ByLineWeightDefault, False, False) '不可打印
StartOverRule(RXClass.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline)), NewRule)
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
acDoc.Editor.WriteMessage(vbCrLf & "图层分别为: Zt_全建筑面积标注和 Zt_全建筑面积标注")
acDoc.Editor.Regen()
End Sub
<CommandMethod("ZtJZMJEnd")> _
Public Sub OveruleEnd()
EndOverRule(RXClass.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline)), NewRule)
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
acDoc.Editor.Regen()
End Sub
Public Shared Sub StartOverRule(ByVal CADClass As RXClass, ByVal Rule As Overrule)
Overrule.AddOverrule(CADClass, Rule, False)
Overrule.Overruling = True
End Sub
Public Shared Sub EndOverRule(ByVal CADClass As RXClass, ByVal Rule As Overrule)
Overrule.Overruling = False
Overrule.RemoveOverrule(CADClass, Rule)
End Sub
End Class
Public Class JZMJ
Inherits DrawableOverrule
Public Overrides Function WorldDraw(ByVal drawable As Autodesk.AutoCAD.GraphicsInterface.Drawable, ByVal wd As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
If TypeOf drawable Is Autodesk.AutoCAD.DatabaseServices.Polyline Then
Dim PL As Autodesk.AutoCAD.DatabaseServices.Polyline = DirectCast(drawable, Autodesk.AutoCAD.DatabaseServices.Polyline)
'Dim PL As Autodesk.AutoCAD.DatabaseServices.Polyline = TryCast(drawable, Autodesk.AutoCAD.DatabaseServices.Polyline)
Dim LN As String = PL.Layer
If LN.Contains("Zt_全建筑面积") = True And PL.Closed = True Then
Dim A As Double = PL.Area
Dim P As Point3d = GetCentroid(PL)
'P = GetPointAR_Radian(P, Math.PI, 2000)
'P = GetPointAR_Radian(P, Math.PI / 2, 200)
P = GetPointXY(P, -2000, 200)
Dim acMText As MText = New MText()
acMText.Layer = "0" '保存图层，否则双击修改后会变为当前图层
acMText.ColorIndex = 256
acMText.Rotation = 0
acMText.Location = P
acMText.Width = 4000
acMText.TextHeight = 350
acMText.Contents = "\pxqc;{\fSimHei;\W0.7;" & "全建筑面积:" & Format(A / 1000 / 1000, "0.00") & "m2}"
acMText.WorldDraw(wd)
acMText.Dispose()
Return MyBase.WorldDraw(drawable, wd)
ElseIf LN.Contains("Zt_半建筑面积") = True And PL.Closed = True Then
Dim A As Double = PL.Area
Dim P As Point3d = GetCentroid(PL)
'P = GetPointAR_Radian(P, Math.PI, 2000)
'P = GetPointAR_Radian(P, Math.PI / 2, 200)
P = GetPointXY(P, -2000, 200)
Dim acMText As MText = New MText()
acMText.Layer = "0" '保存图层，否则双击修改后会变为当前图层
acMText.ColorIndex = 256
acMText.Rotation = 0
acMText.Location = P
acMText.Width = 4000
acMText.TextHeight = 350
acMText.Contents = "\pxqc;{\fSimHei;\W0.7;" & "半建筑面积:" & Format(A / 2 / 1000 / 1000, "0.00") & "m2}"
acMText.WorldDraw(wd)
acMText.Dispose()
Return MyBase.WorldDraw(drawable, wd)
Else
Return MyBase.WorldDraw(drawable, wd)
End If
Return MyBase.WorldDraw(drawable, wd)
Else
'不是多段线
Return MyBase.WorldDraw(drawable, wd)
End If
End Function
Private Function VectorQ(ByVal pl As Autodesk.AutoCAD.DatabaseServices.Polyline, ByVal pt As Point3d) As Vector3d
Dim vecDir As New Vector3d(1, 0, 0)
Dim gripPts As Point3dCollection = New Point3dCollection
Dim IC1 As IntegerCollection = New IntegerCollection
Dim IC2 As IntegerCollection = New IntegerCollection
pl.GetGripPoints(gripPts, IC1, IC2)
'gripPts.ClearCenterPt(1)
Dim i As Integer = 0
While i < gripPts.Count - 1
Dim ln As New LineSegment3d(gripPts(i), gripPts(i + 1))
Dim ptOnCrv3d As PointOnCurve3d = ln.GetClosestPointTo(pt)
Dim dDis As Double = ptOnCrv3d.Point.DistanceTo(pt)
If dDis < 0.0001 Then
vecDir = ln.Direction
Return vecDir
End If
i += 1
End While
Return vecDir
End Function
Public Function GetPointAR_Radian(ByVal P As Point3d, ByVal Angle As Double, ByVal Radius As Double) As Point3d
GetPointAR_Radian = New Point3d(P.X + System.Math.Cos(Angle) * Radius, P.Y + System.Math.Sin(Angle) * Radius, P.Z)
End Function
Public Function GetPointXY(ByVal P As Point3d, ByVal X As Double, ByVal Y As Double) As Point3d
GetPointXY = New Point3d(P.X + X, P.Y + Y, P.Z)
End Function
'返回两点间中心点
''' <summary>
''' 返回两点间中心点
''' </summary>
''' <param name="P1"></param>
''' <param name="P2"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function P2P_Center(ByVal P1 As Point3d, ByVal P2 As Point3d) As Point3d
Return New Point3d((P1.X + P2.X) / 2, _
(P1.Y + P2.Y) / 2, _
(P1.Z + P2.Z) / 2)
End Function
Public Function GetCentroid(ByVal pl As Autodesk.AutoCAD.DatabaseServices.Polyline) As Point3d
Dim p0 As Point2d = pl.GetPoint2dAt(0)
Dim cen As New Point2d(0.0, 0.0)
Dim area As Double = 0.0
Dim bulge As Double = pl.GetBulgeAt(0)
Dim last As Integer = pl.NumberOfVertices - 1
Dim tmpArea As Double
Dim tmpPoint As Point2d
If bulge <> 0.0 Then
Dim datas As Double() = GetArcGeom(pl, bulge, 0, 1)
area = datas(0)
cen = New Point2d(datas(1), datas(2)) * datas(0)
End If
Dim i As Integer = 1
While i < last
tmpArea = TriangleAlgebricArea(p0, pl.GetPoint2dAt(i), pl.GetPoint2dAt(i + 1))
tmpPoint = TriangleCentroid(p0, pl.GetPoint2dAt(i), pl.GetPoint2dAt(i + 1))
cen += (tmpPoint * tmpArea).GetAsVector()
area += tmpArea
bulge = pl.GetBulgeAt(i)
If bulge <> 0.0 Then
Dim datas As Double() = GetArcGeom(pl, bulge, i, i + 1)
area += datas(0)
cen += New Vector2d(datas(1), datas(2)) * datas(0)
End If
System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
bulge = pl.GetBulgeAt(last)
If bulge <> 0.0 Then
Dim datas As Double() = GetArcGeom(pl, bulge, last, 0)
area += datas(0)
cen += New Vector2d(datas(1), datas(2)) * datas(0)
End If
cen = cen.DivideBy(area)
Dim result As New Point3d(cen.X, cen.Y, pl.Elevation)
Return result.TransformBy(Matrix3d.PlaneToWorld(pl.Normal))
End Function
Public Function GetArcGeom(ByVal pl As Autodesk.AutoCAD.DatabaseServices.Polyline, ByVal bulge As Double, ByVal index1 As Integer, ByVal index2 As Integer) As Double()
Dim arc As CircularArc2d = pl.GetArcSegment2dAt(index1)
Dim arcRadius As Double = arc.Radius
Dim arcCenter As Point2d = arc.Center
Dim arcAngle As Double = 4.0 * Math.Atan(bulge)
Dim tmpArea As Double = ArcAlgebricArea(arcRadius, arcAngle)
Dim tmpPoint As Point2d = ArcCentroid(pl.GetPoint2dAt(index1), pl.GetPoint2dAt(index2), arcCenter, tmpArea)
Dim D As Double() = Nothing
D.SetValue(tmpArea, 0)
D.SetValue(tmpPoint.X, 1)
D.SetValue(tmpPoint.Y, 2)
Return D
End Function
Public Function TriangleCentroid(ByVal p0 As Point2d, ByVal p1 As Point2d, ByVal p2 As Point2d) As Point2d
Return (p0 + p1.GetAsVector() + p2.GetAsVector()) / 3.0
End Function
Public Function TriangleAlgebricArea(ByVal p0 As Point2d, ByVal p1 As Point2d, ByVal p2 As Point2d) As Double
Return (((p1.X - p0.X) * (p2.Y - p0.Y)) - ((p2.X - p0.X) * (p1.Y - p0.Y))) / 2.0
End Function
Public Function ArcCentroid(ByVal start As Point2d, ByVal [end] As Point2d, ByVal cen As Point2d, ByVal tmpArea As Double) As Point2d
Dim chord As Double = start.GetDistanceTo([end])
Dim angle As Double = AngleFromTo(start, [end])
Return Polar2d(cen, angle - (Math.PI / 2.0), (chord * chord * chord) / (12.0 * tmpArea))
End Function
Public Function ArcAlgebricArea(ByVal rad As Double, ByVal ang As Double) As Double
Return rad * rad * (ang - Math.Sin(ang)) / 2.0
End Function
Public Function AngleFromTo(ByVal p1 As Point2d, ByVal p2 As Point2d) As Double
Return (p2 - p1).Angle
End Function
Public Function Polar2d(ByVal org As Point2d, ByVal angle As Double, ByVal distance As Double) As Point2d
Return New Point2d(org.X + distance, org.Y).RotateBy(angle, org)
End Function
End Class
End Namespace

'建筑面积 
Namespace ZtJZMJ 
    Public Class JZMJ_Overule 
        Dim NewRule As New JZMJ 
        <CommandMethod("ZtJZMJStart")> _ 
        Public Sub OveruleStart() 
            On Error Resume Next 
            ACADFunctions.CreateLayer("Zt_全建筑面积标注", 2, "continuous", LineWeight.ByLineWeightDefault, False, False) '不可打印 
            ACADFunctions.CreateLayer("Zt_半建筑面积标注", 2, "continuous", LineWeight.ByLineWeightDefault, False, False) '不可打印 
 
            StartOverRule(RXClass.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline)), NewRule) 
            Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument 
            acDoc.Editor.WriteMessage(vbCrLf & "图层分别为: Zt_全建筑面积标注 和 Zt_全建筑面积标注") 
            acDoc.Editor.Regen() 
        End Sub 
        <CommandMethod("ZtJZMJEnd")> _ 
        Public Sub OveruleEnd() 
            EndOverRule(RXClass.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Polyline)), NewRule) 
            Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument 
            acDoc.Editor.Regen() 
        End Sub 
        Public Shared Sub StartOverRule(ByVal CADClass As RXClass, ByVal Rule As Overrule) 
            Overrule.AddOverrule(CADClass, Rule, False) 
            Overrule.Overruling = True 
        End Sub 
        Public Shared Sub EndOverRule(ByVal CADClass As RXClass, ByVal Rule As Overrule) 
            Overrule.Overruling = False 
            Overrule.RemoveOverrule(CADClass, Rule) 
        End Sub 
    End Class 
    Public Class JZMJ 
        Inherits DrawableOverrule 
        Public Overrides Function WorldDraw(ByVal drawable As Autodesk.AutoCAD.GraphicsInterface.Drawable, ByVal wd As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean 
            Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument 
            If TypeOf drawable Is Autodesk.AutoCAD.DatabaseServices.Polyline Then 
                Dim PL As Autodesk.AutoCAD.DatabaseServices.Polyline = DirectCast(drawable, Autodesk.AutoCAD.DatabaseServices.Polyline) 
                'Dim PL As Autodesk.AutoCAD.DatabaseServices.Polyline = TryCast(drawable, Autodesk.AutoCAD.DatabaseServices.Polyline) 
                Dim LN As String = PL.Layer 
                If LN.Contains("Zt_全建筑面积") = True And PL.Closed = True Then 
                    Dim A As Double = PL.Area 
                    Dim P As Point3d = GetCentroid(PL) 
                    'P = GetPointAR_Radian(P, Math.PI, 2000) 
                    'P = GetPointAR_Radian(P, Math.PI / 2, 200) 
                    P = GetPointXY(P, -2000, 200) 
                    Dim acMText As MText = New MText() 
                    acMText.Layer = "0"     '保存图层，否则双击修改后会变为当前图层 
                    acMText.ColorIndex = 256 
                    acMText.Rotation = 0 
                    acMText.Location = P 
                    acMText.Width = 4000 
                    acMText.TextHeight = 350 
                    acMText.Contents = "\pxqc;{\fSimHei;\W0.7;" & "全建筑面积:" & Format(A / 1000 / 1000, "0.00") & "m2}" 
                    acMText.WorldDraw(wd) 
                    acMText.Dispose() 
                    Return MyBase.WorldDraw(drawable, wd) 
                ElseIf LN.Contains("Zt_半建筑面积") = True And PL.Closed = True Then 
                    Dim A As Double = PL.Area 
                    Dim P As Point3d = GetCentroid(PL) 
                    'P = GetPointAR_Radian(P, Math.PI, 2000) 
                    'P = GetPointAR_Radian(P, Math.PI / 2, 200) 
                    P = GetPointXY(P, -2000, 200) 
                    Dim acMText As MText = New MText() 
                    acMText.Layer = "0"     '保存图层，否则双击修改后会变为当前图层 
                    acMText.ColorIndex = 256 
                    acMText.Rotation = 0 
                    acMText.Location = P 
                    acMText.Width = 4000 
                    acMText.TextHeight = 350 
                    acMText.Contents = "\pxqc;{\fSimHei;\W0.7;" & "半建筑面积:" & Format(A / 2 / 1000 / 1000, "0.00") & "m2}" 
                    acMText.WorldDraw(wd) 
                    acMText.Dispose() 
                    Return MyBase.WorldDraw(drawable, wd) 
                Else 
                    Return MyBase.WorldDraw(drawable, wd) 
                End If 
                Return MyBase.WorldDraw(drawable, wd) 
            Else 
                '不是多段线 
                Return MyBase.WorldDraw(drawable, wd) 
            End If 
        End Function 
        Private Function VectorQ(ByVal pl As Autodesk.AutoCAD.DatabaseServices.Polyline, ByVal pt As Point3d) As Vector3d 
            Dim vecDir As New Vector3d(1, 0, 0) 
            Dim gripPts As Point3dCollection = New Point3dCollection 
            Dim IC1 As IntegerCollection = New IntegerCollection 
            Dim IC2 As IntegerCollection = New IntegerCollection 
            pl.GetGripPoints(gripPts, IC1, IC2) 
            'gripPts.ClearCenterPt(1) 
            Dim i As Integer = 0 
            While i < gripPts.Count - 1 
                Dim ln As New LineSegment3d(gripPts(i), gripPts(i + 1)) 
                Dim ptOnCrv3d As PointOnCurve3d = ln.GetClosestPointTo(pt) 
                Dim dDis As Double = ptOnCrv3d.Point.DistanceTo(pt) 
                If dDis < 0.0001 Then 
                    vecDir = ln.Direction 
                    Return vecDir 
                End If 
                i += 1 
            End While 
            Return vecDir 
        End Function 
        Public Function GetPointAR_Radian(ByVal P As Point3d, ByVal Angle As Double, ByVal Radius As Double) As Point3d 
            GetPointAR_Radian = New Point3d(P.X + System.Math.Cos(Angle) * Radius, P.Y + System.Math.Sin(Angle) * Radius, P.Z) 
        End Function 
        Public Function GetPointXY(ByVal P As Point3d, ByVal X As Double, ByVal Y As Double) As Point3d 
            GetPointXY = New Point3d(P.X + X, P.Y + Y, P.Z) 
        End Function 
        '返回两点间中心点 
        ''' <summary> 
        ''' 返回两点间中心点 
        ''' </summary> 
        ''' <param name="P1"></param> 
        ''' <param name="P2"></param> 
        ''' <returns></returns> 
        ''' <remarks></remarks> 
        Public Function P2P_Center(ByVal P1 As Point3d, ByVal P2 As Point3d) As Point3d 
            Return New Point3d((P1.X + P2.X) / 2, _ 
                            (P1.Y + P2.Y) / 2, _ 
                            (P1.Z + P2.Z) / 2) 
        End Function 
        Public Function GetCentroid(ByVal pl As Autodesk.AutoCAD.DatabaseServices.Polyline) As Point3d 
            Dim p0 As Point2d = pl.GetPoint2dAt(0) 
            Dim cen As New Point2d(0.0, 0.0) 
            Dim area As Double = 0.0 
            Dim bulge As Double = pl.GetBulgeAt(0) 
            Dim last As Integer = pl.NumberOfVertices - 1 
            Dim tmpArea As Double 
            Dim tmpPoint As Point2d 
 
            If bulge <> 0.0 Then 
                Dim datas As Double() = GetArcGeom(pl, bulge, 0, 1) 
                area = datas(0) 
                cen = New Point2d(datas(1), datas(2)) * datas(0) 
            End If 
            Dim i As Integer = 1 
            While i < last 
                tmpArea = TriangleAlgebricArea(p0, pl.GetPoint2dAt(i), pl.GetPoint2dAt(i + 1)) 
                tmpPoint = TriangleCentroid(p0, pl.GetPoint2dAt(i), pl.GetPoint2dAt(i + 1)) 
                cen += (tmpPoint * tmpArea).GetAsVector() 
                area += tmpArea 
                bulge = pl.GetBulgeAt(i) 
                If bulge <> 0.0 Then 
                    Dim datas As Double() = GetArcGeom(pl, bulge, i, i + 1) 
                    area += datas(0) 
                    cen += New Vector2d(datas(1), datas(2)) * datas(0) 
                End If 
                System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1) 
            End While 
            bulge = pl.GetBulgeAt(last) 
            If bulge <> 0.0 Then 
                Dim datas As Double() = GetArcGeom(pl, bulge, last, 0) 
                area += datas(0) 
                cen += New Vector2d(datas(1), datas(2)) * datas(0) 
            End If 
            cen = cen.DivideBy(area) 
            Dim result As New Point3d(cen.X, cen.Y, pl.Elevation) 
            Return result.TransformBy(Matrix3d.PlaneToWorld(pl.Normal)) 
        End Function 
        Public Function GetArcGeom(ByVal pl As Autodesk.AutoCAD.DatabaseServices.Polyline, ByVal bulge As Double, ByVal index1 As Integer, ByVal index2 As Integer) As Double() 
            Dim arc As CircularArc2d = pl.GetArcSegment2dAt(index1) 
            Dim arcRadius As Double = arc.Radius 
            Dim arcCenter As Point2d = arc.Center 
            Dim arcAngle As Double = 4.0 * Math.Atan(bulge) 
            Dim tmpArea As Double = ArcAlgebricArea(arcRadius, arcAngle) 
            Dim tmpPoint As Point2d = ArcCentroid(pl.GetPoint2dAt(index1), pl.GetPoint2dAt(index2), arcCenter, tmpArea) 
            Dim D As Double() = Nothing 
            D.SetValue(tmpArea, 0) 
            D.SetValue(tmpPoint.X, 1) 
            D.SetValue(tmpPoint.Y, 2) 
            Return D 
        End Function 
        Public Function TriangleCentroid(ByVal p0 As Point2d, ByVal p1 As Point2d, ByVal p2 As Point2d) As Point2d 
            Return (p0 + p1.GetAsVector() + p2.GetAsVector()) / 3.0 
        End Function 
        Public Function TriangleAlgebricArea(ByVal p0 As Point2d, ByVal p1 As Point2d, ByVal p2 As Point2d) As Double 
            Return (((p1.X - p0.X) * (p2.Y - p0.Y)) - ((p2.X - p0.X) * (p1.Y - p0.Y))) / 2.0 
        End Function 
        Public Function ArcCentroid(ByVal start As Point2d, ByVal [end] As Point2d, ByVal cen As Point2d, ByVal tmpArea As Double) As Point2d 
            Dim chord As Double = start.GetDistanceTo([end]) 
            Dim angle As Double = AngleFromTo(start, [end]) 
            Return Polar2d(cen, angle - (Math.PI / 2.0), (chord * chord * chord) / (12.0 * tmpArea)) 
        End Function 
        Public Function ArcAlgebricArea(ByVal rad As Double, ByVal ang As Double) As Double 
            Return rad * rad * (ang - Math.Sin(ang)) / 2.0 
        End Function 
        Public Function AngleFromTo(ByVal p1 As Point2d, ByVal p2 As Point2d) As Double 
            Return (p2 - p1).Angle 
        End Function 
        Public Function Polar2d(ByVal org As Point2d, ByVal angle As Double, ByVal distance As Double) As Point2d 
            Return New Point2d(org.X + distance, org.Y).RotateBy(angle, org) 
        End Function 
    End Class 
End Namespace

d1742647821 · 发表于 2023-12-4 19:46:34

ifox写的要不要

d1742647821 · 发表于 2023-12-4 20:46:27

效果如下

如果无法播放，请点击此处在新窗口打开

powered By IFox 需要使用ifox类库才可使用
https://gitee.com/inspirefunction/ifoxcad

namespace DYH.Demo测试;
public static class Test
{
[CommandMethod(nameof(TestArea))]
public static void TestArea()
{
// 提示用户选择
var r1 = Env.Editor.GetEntity("\n选择闭合多段线");
if (r1.Status != PromptStatus.OK)
return;
// 开ifox事务
using var tr = new DBTrans();
// 如果对象不是点数量大于2的闭合多段线，则程序结束
if (tr.GetObject(r1.ObjectId, OpenMode.ForWrite) is not Polyline
{
Closed: true, NumberOfVertices: > 2, HasBulges: false
}
pl)
return;
// 获取中心点
var midPoint = pl.GetBoundingBoxEx()!.Value.MidCenter;
// 文字创建
using var text1 = DBTextEx.CreateDBText(midPoint, (pl.Area / 1e6).ToString("0.00"), 300,
AttachmentPoint.MiddleCenter);
text1.ColorIndex = 1;
var pickedPoint = r1.PickedPoint.Ucs2Wcs();
var selectedIndex = (int)Math.Floor(pl.GetParameterAtPoint(pl.GetClosestPointTo(pickedPoint, false)));
// 拿到两个拉伸坐标
var stretchIndex1 = selectedIndex;
var stretchIndex2 = (selectedIndex + 1) % pl.NumberOfVertices;
// 拿到对应线段
var ls1 = pl.GetLineSegment2dAt((stretchIndex1 - 1 + pl.NumberOfVertices) % pl.NumberOfVertices);
var ls2 = pl.GetLineSegment2dAt(stretchIndex2);
var lsJig = pl.GetLineSegment2dAt(stretchIndex1);
// 拿到构造线
var line2d1 = new Line2d(ls1.StartPoint, ls1.Direction);
var line2d2 = new Line2d(ls2.StartPoint, ls2.Direction);
var line2dJig = new Line2d(lsJig.StartPoint, lsJig.Direction);
// 拿到两个
var lastPoint = lsJig.StartPoint;
var cci2d = new CurveCurveIntersector2d();
using var j2 = new JigEx((mpw, _) =>
{
var mp2d = mpw.Point2d();
line2dJig.TransformBy(Matrix2d.Displacement(mp2d - lastPoint));
cci2d.Set(line2dJig, line2d1);
if (cci2d.NumberOfIntersectionPoints == 1)
{
var pt1 = cci2d.GetPointOnCurve2(0).Point;
cci2d.Set(line2dJig, line2d2);
if (cci2d.NumberOfIntersectionPoints == 1)
{
var pt2 = cci2d.GetPointOnCurve2(0).Point;
pl.SetPointAt(stretchIndex1, pt1);
pl.SetPointAt(stretchIndex2, pt2);
pl.Draw();
text1.TextString = (pl.Area / 1e6).ToString("0.00");
var box = pl.GetBoundingBoxEx()!.Value;
text1.Move(text1.AlignmentPoint, box.MidCenter);
text1.Height = Math.Min(box.Width, box.Height) * 0.1;
text1.AdjustAlignment(tr.Database);
}
}
lastPoint = mp2d;
});
j2.DatabaseEntityDraw(wd => wd.Geometry.Draw(pl, text1));
j2.SetOptions("\n选择位置");
var r2 = Env.Editor.Drag(j2);
if (r2.Status != PromptStatus.OK)
{
tr.Abort();
return;
}
Env.Editor.Redraw(pl);
}
}

namespace DYH.Demo测试; 
 
public static class Test 
{ 
    [CommandMethod(nameof(TestArea))] 
    public static void TestArea() 
    { 
        // 提示用户选择 
        var r1 = Env.Editor.GetEntity("\n选择闭合多段线"); 
        if (r1.Status != PromptStatus.OK) 
            return; 
        // 开ifox事务 
        using var tr = new DBTrans(); 
        // 如果对象不是点数量大于2的闭合多段线，则程序结束 
        if (tr.GetObject(r1.ObjectId, OpenMode.ForWrite) is not Polyline 
                { 
                    Closed: true, NumberOfVertices: > 2, HasBulges: false 
                } 
                pl) 
            return; 
        // 获取中心点 
        var midPoint = pl.GetBoundingBoxEx()!.Value.MidCenter; 
        // 文字创建 
        using var text1 = DBTextEx.CreateDBText(midPoint, (pl.Area / 1e6).ToString("0.00"), 300, 
            AttachmentPoint.MiddleCenter); 
        text1.ColorIndex = 1; 
        var pickedPoint = r1.PickedPoint.Ucs2Wcs(); 
        var selectedIndex = (int)Math.Floor(pl.GetParameterAtPoint(pl.GetClosestPointTo(pickedPoint, false))); 
        // 拿到两个拉伸坐标 
        var stretchIndex1 = selectedIndex; 
        var stretchIndex2 = (selectedIndex + 1) % pl.NumberOfVertices; 
        // 拿到对应线段 
        var ls1 = pl.GetLineSegment2dAt((stretchIndex1 - 1 + pl.NumberOfVertices) % pl.NumberOfVertices); 
        var ls2 = pl.GetLineSegment2dAt(stretchIndex2); 
        var lsJig = pl.GetLineSegment2dAt(stretchIndex1); 
        // 拿到构造线 
        var line2d1 = new Line2d(ls1.StartPoint, ls1.Direction); 
        var line2d2 = new Line2d(ls2.StartPoint, ls2.Direction); 
        var line2dJig = new Line2d(lsJig.StartPoint, lsJig.Direction); 
        // 拿到两个 
        var lastPoint = lsJig.StartPoint; 
        var cci2d = new CurveCurveIntersector2d(); 
        using var j2 = new JigEx((mpw, _) => 
        { 
            var mp2d = mpw.Point2d(); 
            line2dJig.TransformBy(Matrix2d.Displacement(mp2d - lastPoint)); 
            cci2d.Set(line2dJig, line2d1); 
            if (cci2d.NumberOfIntersectionPoints == 1) 
            { 
                var pt1 = cci2d.GetPointOnCurve2(0).Point; 
                cci2d.Set(line2dJig, line2d2); 
                if (cci2d.NumberOfIntersectionPoints == 1) 
                { 
                    var pt2 = cci2d.GetPointOnCurve2(0).Point; 
                    pl.SetPointAt(stretchIndex1, pt1); 
                    pl.SetPointAt(stretchIndex2, pt2); 
                    pl.Draw(); 
                    text1.TextString = (pl.Area / 1e6).ToString("0.00"); 
                    var box = pl.GetBoundingBoxEx()!.Value; 
                    text1.Move(text1.AlignmentPoint, box.MidCenter); 
                    text1.Height = Math.Min(box.Width, box.Height) * 0.1; 
                    text1.AdjustAlignment(tr.Database); 
                } 
            } 
 
            lastPoint = mp2d; 
        }); 
        j2.DatabaseEntityDraw(wd => wd.Geometry.Draw(pl, text1)); 
        j2.SetOptions("\n选择位置"); 
        var r2 = Env.Editor.Drag(j2); 
        if (r2.Status != PromptStatus.OK) 
        { 
            tr.Abort(); 
            return; 
        } 
 
        Env.Editor.Redraw(pl); 
    } 
}

d1742647821 · 发表于 2023-12-4 20:55:42

拉角点更简单，同样需要使用ifox

如果无法播放，请点击此处在新窗口打开

https://gitee.com/inspirefunction/ifoxcad

public static class Test2
{
[CommandMethod(nameof(TestArea2))]
public static void TestArea2()
{
// 提示用户选择
var r1 = Env.Editor.GetEntity("\n选择闭合多段线");
if (r1.Status != PromptStatus.OK)
return;
// 开ifox事务
using var tr = new DBTrans();
// 如果对象不是点数量大于2的闭合多段线，则程序结束
if (tr.GetObject(r1.ObjectId, OpenMode.ForWrite) is not Polyline
{
Closed: true, NumberOfVertices: > 2, HasBulges: false
}
pl)
return;
// 获取中心点
var midPoint = pl.GetBoundingBoxEx()!.Value.MidCenter;
// 文字创建
using var text1 = DBTextEx.CreateDBText(midPoint, (pl.Area / 1e6).ToString("0.00"), 300,
AttachmentPoint.MiddleCenter);
text1.ColorIndex = 1;
var pickedPoint = r1.PickedPoint.Ucs2Wcs();
var pts = pl.GetPoints();
var selectedIndex = pts.FindIndex(e1=> e1== pts.FindByMin(e2 => pickedPoint.DistanceTo(e2)));
// 拿到两个
using var j2 = new JigEx((mpw, _) =>
{
var mp2d = mpw.Point2d();
pl.SetPointAt(selectedIndex,mp2d);
pl.Draw();
text1.TextString = (pl.Area / 1e6).ToString("0.00");
var box = pl.GetBoundingBoxEx()!.Value;
text1.Move(text1.AlignmentPoint, box.MidCenter);
text1.Height = Math.Min(box.Width, box.Height) * 0.1;
text1.AdjustAlignment(tr.Database);
});
j2.DatabaseEntityDraw(wd => wd.Geometry.Draw(pl, text1));
j2.SetOptions("\n选择位置");
var r2 = Env.Editor.Drag(j2);
if (r2.Status != PromptStatus.OK)
{
tr.Abort();
return;
}
Env.Editor.Redraw(pl);
}
}

public static class Test2 
{ 
    [CommandMethod(nameof(TestArea2))] 
    public static void TestArea2() 
    { 
        // 提示用户选择 
        var r1 = Env.Editor.GetEntity("\n选择闭合多段线"); 
        if (r1.Status != PromptStatus.OK) 
            return; 
        // 开ifox事务 
        using var tr = new DBTrans(); 
        // 如果对象不是点数量大于2的闭合多段线，则程序结束 
        if (tr.GetObject(r1.ObjectId, OpenMode.ForWrite) is not Polyline 
                { 
                    Closed: true, NumberOfVertices: > 2, HasBulges: false 
                } 
                pl) 
            return; 
        // 获取中心点 
        var midPoint = pl.GetBoundingBoxEx()!.Value.MidCenter; 
        // 文字创建 
        using var text1 = DBTextEx.CreateDBText(midPoint, (pl.Area / 1e6).ToString("0.00"), 300, 
            AttachmentPoint.MiddleCenter); 
        text1.ColorIndex = 1; 
        var pickedPoint = r1.PickedPoint.Ucs2Wcs(); 
        var pts = pl.GetPoints(); 
        var selectedIndex = pts.FindIndex(e1=> e1== pts.FindByMin(e2 => pickedPoint.DistanceTo(e2))); 
        // 拿到两个 
        using var j2 = new JigEx((mpw, _) => 
        { 
            var mp2d = mpw.Point2d(); 
            pl.SetPointAt(selectedIndex,mp2d); 
            pl.Draw(); 
            text1.TextString = (pl.Area / 1e6).ToString("0.00"); 
            var box = pl.GetBoundingBoxEx()!.Value; 
            text1.Move(text1.AlignmentPoint, box.MidCenter); 
            text1.Height = Math.Min(box.Width, box.Height) * 0.1; 
            text1.AdjustAlignment(tr.Database); 
        }); 
        j2.DatabaseEntityDraw(wd => wd.Geometry.Draw(pl, text1)); 
        j2.SetOptions("\n选择位置"); 
        var r2 = Env.Editor.Drag(j2); 
        if (r2.Status != PromptStatus.OK) 
        { 
            tr.Abort(); 
            return; 
        } 
 
        Env.Editor.Redraw(pl); 
    } 
}

账号		自动登录	找回密码
密码			注册

[基础] 如何实现动态面积呢

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源