社区 › VB › 在矩形的中点创建多行文字

Humbertogo 发表于 2007-5-30 07:51:20

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

帮助
如何在矩形的中点和相同角度添加多行文字？
**** Hidden Message *****

Sdoman 发表于 2007-5-30 08:36:11

能否从矩形的边界框中获得两个坐标，然后计算中点？我无法帮助您使用VBA，但前几天我在Vlisp中完成了几乎相同的编码任务。

DaveW 发表于 2007-5-30 09:58:54

角度是3D还是2D？

Humbertogo 发表于 2007-5-30 10:02:22

角度是2D

Bryco 发表于 2007-5-30 10:16:35

描述矩形。它是否具有相同的大小等。

Humbertogo 发表于 2007-5-30 10:20:05

这是我的一个程序中的一个小片段。 它使用常规文本。 它允许用户选择两个点来创建矩形，并自动在矩形的中心添加文本。
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 发表于 2007-5-30 10:25:37

附加

Fatty 发表于 2007-5-30 10:33:07

那是，嗯.....不是矩形。 关闭，但它不是矩形。
听起来/看起来像你需要找到一个闭合折线的质心，而不是？？

Bryco 发表于 2007-5-30 10:50:54

这很容易做到，并且会帮助每个人，如果你尝试先编码，到目前为止你已经完成了多少代码？
谢谢。

DaveW 发表于 2007-5-30 10:59:53

在我的绘图中，我有一个不同的矩形＜br＞我得到了一些点，并创建了一条闭合多段线＜br＞Dim LastObj作为AcadEntity＜br＞Dim objLWPolyline（0）作为AcadLWPolyline＜br＞Dim minExt作为变体＜br＞作为变体的Dim maxExt＜br＞将Dim MTextObj作为AcadMText＜br＞创建了一个双＜br＞的Dim角（0到2）＜作为变量的Dim Pt，_＜br＞varArea作为字符串，_
pstr作为字符串，_
sysVarName2作为字符串，
sysVarName2作为字符串，_，_，0＜br＞Tony Tanzillo的多获取点方法＜br＞Msg=vbCrLf&选择一个内部点＜br＞在出错时执行＜br＞下一步＜br＞Pt=.Utility。获取点（，Msg）
如果出错，则
出错。如果
在错误转到0时，清除
退出并执行
结束
pstr=Replace（CStr（Pt（0））、“、”、“、“）&”、“&
Replace（（CStr）（Pt（1））、“，”、“，“）
。SendCommand Chr（3）&Chr（三）&vbCr&pstr&vbCr＆vbCr&vbCr＜br＞设置LastObj=.ModelSpace.Item（.ModelSpace.Count-1）＜br＞如果LastObj的类型是AcadLWPolyline，则设置objlwpolyleine（0）＝lastobjl＜br＞objlvpolyline（0）。GetBoundingBox varMinPt，varMaxPt＜br＞objLWPolyline（0）。如果＜br＞角（0）＝varMinPt（0）：角（1）＝var maxpt（1）：角（2）＝0#＜br＞高度＝2000#＜br＞则删除＜br＞结束＜br＞设置MTextObj=.ModelSpace。添加MTEXT（角落，10，“50”）
MTEXTEXT。高度=高度
“mtexobj。旋转MTBJ。插入点，lineObj。角度＜br＞‘MTextObj。移动MTBJ。插入点，lineObj。端点＜br＞设置textObj=.ModelSpace。添加文本（可变区域，Pt，高度）
'textObj。更新＜br＞Msg=vbCrLf&“下一个内部点或回车退出：＜br＞循环＜br＞在错误转到0＜br＞时。SetVariable“OSMODE”，703＜br＞setvariate“CMDECHO”，1＜br＞以＜br＞MsgBox“完成”结束＜br＞结束子＜br＞

查看完整版本: 在矩形的中点创建多行文字