在矩形的中点创建多行文字

Bryco · 发表于 2007-5-30 12:31:21

我明白为什么了，我从来没有完全使用VBA，那里的编码很难看…
这是我刚刚在C#中做的一些事情，非常简单，这可能会帮助你，你只需选择一个矩形区域，例程就会在其中放置一个文本。HTH

using System;
using Autodesk.AutoCAD.Runtime;
using System.Collections.Generic;
using System.ComponentModel;
using System.Data;
using System.Text;
using System.IO;
using Autodesk.AutoCAD.ApplicationServices;
using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.Windows;
using Autodesk.AutoCAD.Geometry;
using Autodesk.AutoCAD.EditorInput;
using System.Text.RegularExpressions;
using System.Runtime.InteropServices;
using System.Threading;
using System.Globalization;
using acadApp = Autodesk.AutoCAD.ApplicationServices.Application;
using AcAp = Autodesk.AutoCAD.ApplicationServices;
using AcEd = Autodesk.AutoCAD.EditorInput;
using AcGe = Autodesk.AutoCAD.Geometry;
using AcRx = Autodesk.AutoCAD.Runtime;
using AcDb = Autodesk.AutoCAD.DatabaseServices;
using AcWd = Autodesk.AutoCAD.Windows;

辅助功能：

copy

        public static double Angle(Point3d pt1, Point3d pt2)
        {
            return Math.Atan2((pt2.Y - pt1.Y), (pt2.X - pt1.X));
        }
        public static Point3d Polar(Point3d ptBase, double angle, double distance)
        {
            return new Point3d(ptBase.X + (distance * Math.Cos(angle)), ptBase.Y + (distance * Math.Sin(angle)), 0.0);
        }
        public static double Distance(Point3d pt1, Point3d pt2)
        {
            return Math.Sqrt(Math.Pow(pt2.X - pt1.X, 2) + Math.Pow(pt2.Y - pt1.Y, 2));
        }

命令：

copy

        [CommandMethod("PLACETEXT")]//place some text inside a rectangle area
        public void placetext()
        {
            Document doc = acadApp.DocumentManager.MdiActiveDocument;
            Editor ed = doc.Editor;
            Database db = doc.Database;
            PromptEntityResult res = ed.GetEntity("\nSelect the rectangle base line: ");
            if (res.Status != PromptStatus.OK) return;
            using (Transaction tr = db.TransactionManager.StartTransaction())
            {
                Polyline poly = tr.GetObject(res.ObjectId, OpenMode.ForRead, false) as Polyline;
                if (poly != null)
                {
                    Point3d pickPoint = res.PickedPoint;
                    Point3d oPoint = poly.GetClosestPointTo(pickPoint, ed.GetCurrentView().ViewDirection, false);
                    double param = 0;
                    param = poly.GetParameterAtPoint(oPoint);
                    double sparam=0, eparam=0;
                    sparam = (int)param;
                    eparam = sparam + 1;
                    Point3d sp = poly.GetPointAtParameter(sparam);
                    Point3d ep = poly.GetPointAtParameter(eparam);
                    double ang = Angle(sp, ep);
                    Extents3d ext = poly.GeometricExtents;
                    Point3d min = ext.MinPoint;
                    Point3d max = ext.MaxPoint;
                    Point3d geoCtr = Polar(min, Angle(min, max), Distance(min, max) / 2.0);
                    BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite);
                    DBText txt = new DBText();
                    txt.TextString = "TESTING"; //<==change to your default string value
                    txt.SetDatabaseDefaults(db);
                    txt.Height = Distance(min, max) / 8.0; //<==change to your default height
                    txt.HorizontalMode = TextHorizontalMode.TextMid;
                    txt.Rotation = ang;
                    btr.AppendEntity(txt);
                    tr.AddNewlyCreatedDBObject(txt, true);
                    txt.AlignmentPoint = geoCtr;
                }
                tr.Commit();
            }
        }

Bryco · 发表于 2007-5-30 13:33:31

这并不完全是您所需要的，但可能会有帮助，我认为您可以在那里添加部分，以获得所需边缘上的第二个点，然后计算文本的旋转角度；J#039~

copy

Option Explicit
Sub AddSomeLabel()
Dim varPt As Variant
Dim oPoly As AcadLWPolyline
Dim oEnt As AcadEntity
With ThisDrawing
.Utility.GetEntity oEnt, varPt, "Select polyline (pick left point on the edge)"
If TypeOf oEnt Is AcadLWPolyline Then
Set oPoly = oEnt
Else
MsgBox "Wrong entity selected"
Exit Sub
End If
Dim txtPt As Variant
txtPt = PseudoCenter(oPoly)
Dim oText As AcadMText
Dim txtStr As String
txtStr = "Blah\PBlah\PBlah"
Dim pointUCS As Variant
pointUCS = .Utility.TranslateCoordinates(txtPt, acUCS, acUCS, False)
Set oText = MakeMText(pointUCS, txtStr)
End With
End Sub
Function MakeMText(txtPt As Variant, strTxt As String) As AcadMText
Dim oMText As AcadMText
Dim oLine As AcadLine
Set oMText = ThisDrawing.ModelSpace.AddMText(txtPt, 0#, strTxt)
oMText.AttachmentPoint = acAttachmentPointMiddleCenter
oMText.InsertionPoint = txtPt
oMText.Update
Set MakeMText = oMText
End Function
Function PseudoCenter(oPoly As AcadLWPolyline) As Variant
Dim minPt As Variant
Dim maxPt As Variant
oPoly.GetBoundingBox minPt, maxPt
Dim centPt(2) As Double
centPt(0) = (minPt(0) + maxPt(0)) / 2
centPt(1) = (minPt(1) + maxPt(1)) / 2
centPt(2) = (minPt(2) + maxPt(2)) / 2
PseudoCenter = centPt
End Function

Bryco · 发表于 2007-5-30 13:59:59

从数学上讲，这是非常有问题的
第一反应是按照马特的建议使用质心，然而这失败了，因为；L“；由于质心在直线外，
路易斯&#039；s方法始终有效（如果我能正确阅读）

Bryco · 发表于 2007-5-30 14:19:53

很抱歉，我没有时间编写代码，但我会这样做：
我会从多段线生成一个区域。如果多段线不是闭合的，我会将plinetype的系统变量设置为2。然后发送命令pedit，可能会使用多个选项。然后将闭合多段线转换为；区域并获取质心。只要这些所谓的矩形足够接近一个，质心就应该很好
接下来，我将在该矩形中找到最长的线，并得到其起点和终点。从wcs获取其角度，方法是绘制一条线或分析多段线以获取最长的线及其长度。然后使用返回的质心和线/点的角度放置文本。

在矩形的中点创建多行文字

发表回复

精选推荐