Author Topic: create Mtext in the midpoint of a rectangle  (Read 13269 times)

0 Members and 1 Guest are viewing this topic.

Humbertogo

  • Guest
create Mtext in the midpoint of a rectangle
« on: May 30, 2007, 07:51:20 AM »
Help :lol:
How can i addMtext in the midpoint of a rectangle and the same angle of the rectangle?

Sdoman

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #1 on: May 30, 2007, 08:36:11 AM »
Can you get the two coordinates from the rectangle's bounding box, and then calculate the midpoint?  I can't help you with VBA, but I just did almost the same coding task in Vlisp the other day.

DaveW

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #2 on: May 30, 2007, 09:58:54 AM »
Help :lol:
How can i addMtext in the midpoint of a rectangle and the same angle of the rectangle?

Is the angle 3D or 2D?

Humbertogo

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #3 on: May 30, 2007, 10:02:22 AM »
the angle is 2D

Bryco

  • Water Moccasin
  • Posts: 1882
Re: create Mtext in the midpoint of a rectangle
« Reply #4 on: May 30, 2007, 10:16:35 AM »
Describe the rectangle. Is it allways the same size etc.

Guest

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #5 on: May 30, 2007, 10:20:05 AM »
Here's a little snippet from one of my programs.  It uses regular text though.  It allows the user to select two points to create the rectangle and automatically adds the text at the center of the rectangle.


Code: [Select]
Option Explicit

Public Sub DrawTextInRectangle()
    Dim pnt1 As Variant, pnt2 As Variant
    Dim ctr(0 To 2) As Double, ht As Double
    Dim newText As AcadText
    Dim strText As String
    Dim intTextHeight As Integer
   
    strText = "THIS SPACE FOR RENT"
   
    intTextHeight = 10
    If getPoints1(pnt1, pnt2) = 0 Then
        Rectangle pnt1, pnt2
        ' Now add text at the midpoint of the rectangle...
        ctr(0) = (pnt1(0) + pnt2(0)) / 2
        ctr(1) = (pnt1(1) + pnt2(1)) / 2
        ctr(2) = (pnt1(2) + pnt2(2)) / 2
        ht = Abs(pnt1(1) - pnt2(1)) / 2
       
        Set newText = ThisDrawing.ModelSpace.AddText(UCase(strText), ctr, intTextHeight)
        newText.Alignment = 4
        newText.TextAlignmentPoint = ctr
        newText.StyleName = "Standard"
        newText.Update
    End If
End Sub

' From Frank Oquendo
Private Function Rectangle(Point1, Point2) As AcadLWPolyline
    Dim vertices(0 To 7) As Double, pl As AcadLWPolyline

    vertices(0) = CDbl(Point1(0)): vertices(1) = CDbl(Point1(1))
    vertices(2) = CDbl(Point2(0)): vertices(3) = CDbl(Point1(1))
    vertices(4) = CDbl(Point2(0)): vertices(5) = CDbl(Point2(1))
    vertices(6) = CDbl(Point1(0)): vertices(7) = CDbl(Point2(1))

    Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
    pl.Closed = True
    Set Rectangle = pl
End Function

Private Function getPoints1(pt1 As Variant, pt2 As Variant) As Integer
' This sub returns two points, or an error flag if cancelled

   On Error Resume Next
   pt1 = ThisDrawing.Utility.GetPoint(, "Specify first corner:")
   If Err Then
      getPoints1 = -1
      Exit Function
   End If
   pt2 = ThisDrawing.Utility.GetCorner(pt1, "Specify opposite corner:")
   If Err Then
      getPoints1 = -1
      Exit Function
   End If
   On Error GoTo 0
End Function

Humbertogo

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #6 on: May 30, 2007, 10:23:30 AM »

Humbertogo

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #7 on: May 30, 2007, 10:25:37 AM »
attach

Guest

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #8 on: May 30, 2007, 10:33:07 AM »
That's, ummmm..... not a rectangle.  Close, but it's not a rectangle.

Sounds/looks like you need to find the centroid of a closed polyline instead??

LE

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #9 on: May 30, 2007, 10:50:54 AM »
That can be an easy one to do, and will help everyone, if you try to code something first, what is the code you have done, so far?

Thanks.

Humbertogo

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #10 on: May 30, 2007, 10:59:53 AM »
in my drawing i have a different rectangles
i get some point and create a close polyline

     Dim LastObj As AcadEntity
     Dim objLWPolyline(0) As AcadLWPolyline
     Dim minExt As Variant
     Dim maxExt As Variant
     Dim MTextObj As AcadMText
     Dim corner(0 To 2) As Double
   
     Dim Pt As Variant, _
         varArea As String, _
         pstr As String, _
         SysVarName As String, _
         sysVarName2 As String, _
         VarData As Variant, _
         intData As Double, _
         textObj As AcadText, _
         text As Variant, _
         Height As Variant, _
         Msg As String, _
         varMinPt As Variant, _
         varMaxPt As Variant


Private Sub test()

     SysVarName = "DIMSCALE"
     sysVarName2 = "AREA"

     With ThisDrawing

          .SetVariable "OSMODE", 0
          .SetVariable "CMDECHO", 0

          '' Multiple getpoint method by Tony Tanzillo
          Msg = vbCrLf & "Select an Internal Point"

          Do
               On Error Resume Next
               Pt = .Utility.GetPoint(, Msg)
               If Err Then
                    Err.Clear
                    Exit Do
               End If
               On Error GoTo 0

               pstr = Replace(CStr(Pt(0)), ",", ".") & "," & _
                      Replace(CStr(Pt(1)), ",", ".")

               .SendCommand Chr(3) & Chr(3) & "._-boundary" & vbCr & pstr & vbCr & vbCr
             
                  Set LastObj = .ModelSpace.Item(.ModelSpace.Count - 1)
            If TypeOf LastObj Is AcadLWPolyline Then
                  Set objLWPolyline(0) = LastObj
                      objLWPolyline(0).GetBoundingBox varMinPt, varMaxPt
                      objLWPolyline(0).Delete

              End If


              corner(0) = varMinPt(0): corner(1) = varMaxPt(1): corner(2) = 0#

              Height = 2000#

               
               Set MTextObj = .ModelSpace.AddMText(corner, 10, "50")
                   MTextObj.Height = Height
'                   MTextObj.Rotate MTextObj.insertionPoint, lineObj.Angle
'                   MTextObj.Move MTextObj.insertionPoint, lineObj.endPoint
'               Set textObj = .ModelSpace.AddText(varArea, Pt, Height)
'               textObj.Update
               Msg = vbCrLf & "Next Internal Point or ENTER to exit: "

          Loop
          On Error GoTo 0

          .SetVariable "OSMODE", 703
          .SetVariable "CMDECHO", 1

     End With

     MsgBox "Done"


End Sub

LE

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #11 on: May 30, 2007, 12:31:21 PM »
I see why, I never went all the way with VBA, it is ugly the coding there... :)

Here is something I just did in C#, very simple, that might help you, you simple select a rectangle area, and the routine will place a text inside. HTH

Code: [Select]
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;

Auxiliary functions:
Code: [Select]
        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));
        }

Command:
Code: [Select]
        [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();
            }
        }
« Last Edit: May 30, 2007, 12:35:50 PM by LE »

Fatty

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #12 on: May 30, 2007, 01:33:31 PM »
There is not exactly what you
need but may help I think
You can add there the part to get
second point on the desired edge and then
calculate rotation angle of text

~'J'~

Code: [Select]
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

  • Water Moccasin
  • Posts: 1882
Re: create Mtext in the midpoint of a rectangle
« Reply #13 on: May 30, 2007, 01:59:59 PM »
Mathimatically this is very problematic.
The first instinct is to use the centroid as Matt suggested,
however this fails with an "L" as the centroid is outside the line,
Luis's method will always work (if I can read it correctly)

DaveW

  • Guest
Re: create Mtext in the midpoint of a rectangle
« Reply #14 on: May 30, 2007, 02:19:53 PM »
Sorry I do not have time to code it, but this is what I would do:

I would make a region from the polyline. If the polyline is not closed I would set the system variable of plinetype to 2. Then sendcommand pedit, maybe using the multiple option. Then turn the close polyline into a region and get the centroid. As long as these so called rectangles are close enough to one, the centroid should be fine.

Next I would find the longest line in that rectangle and get its start and endpoint. Get its angle from the wcs, either by drawing a line or parsing the polyline for the longest line and their length. Then use the returned centroid and the angle of the line/points to place the text.
« Last Edit: May 30, 2007, 03:18:42 PM by DaveW »