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

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

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

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

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

你能从矩形#039；s边界框，然后计算中点&nbsp；我可以&#039；我无法帮助您使用VBA，但前几天我在Vlisp中完成了几乎相同的编码任务。

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

角度是3D还是2D？

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

角度为2D

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

描述矩形。大小都一样吗。

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

这里是#039；这是我的一个程序中的一个小片段&nbsp；但它使用常规文本&nbsp；它允许用户选择两个点来创建矩形，并自动将文本添加到矩形的中心
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

Bryco 发表于 2007-5-30 10:25:37

贴上

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

即#039；s、 嗯……不是矩形&nbsp；关闭，但它&#039；s不是矩形
听起来/看起来你需要找到闭合多段线的质心？？

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

这可能是一个很容易做到的事情，并将帮助每个人，如果你试图先编码一些东西，你已经做了什么代码，到目前为止
谢谢。

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

在我的绘图中，我有一个不同的矩形，我得到一些点，并创建了一条闭合的多段线&nbsp&nbsp；将LastObj视为身份&nbsp&nbsp；Dim objLWPolyline（0）作为acadlwpolyleine&nbsp&nbsp；Dim minExt作为变体&nbsp&nbsp；Dim maxExt作为变体&nbsp&nbsp；将MTEXTEXT设置为AcadMText&nbsp&nbsp；将拐角（0到2）变暗为双&nbsp
&nbsp&nbsp；Dim Pt作为变体&nbsp&nbsp&nbsp&nbsp；varArea作为字符串&nbsp&nbsp&nbsp&nbsp；pstr作为字符串&nbsp&nbsp&nbsp&nbsp；SysVarName作为字符串&nbsp&nbsp&nbsp&nbsp；sysVarName2作为字符串&nbsp&nbsp&nbsp&nbsp；VarData作为变体&nbsp&nbsp&nbsp&nbsp；intData为双精度&nbsp&nbsp&nbsp&nbsp；textObj作为AcadText，_&nbsp&nbsp&nbsp&nbsp；文本作为变体&nbsp&nbsp&nbsp&nbsp；高度作为变量&nbsp&nbsp&nbsp&nbsp；消息作为字符串&nbsp&nbsp&nbsp&nbsp；Varmimpt作为变体&nbsp&nbsp&nbsp&nbsp；varMaxPt作为变体&nbsp&nbsp；SysVarName=&quot；DIMSCALE“
&nbsp&nbsp；sysVarName2=&quot；面积“
&nbsp&nbsp；使用此图纸&nbsp&nbsp&nbsp&nbsp。设置变量；OSMODE；，0&nbsp&nbsp&nbsp&nbsp。设置变量；CMDECHO“；，0&nbsp&nbsp&nbsp&nbsp'' Tony Tanzillo的多getpoint方法&nbsp&nbsp&nbsp&nbsp；消息=vbCrLf&amp&引用；选择内部点
&nbsp&nbsp&nbsp&nbsp；Do&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；出错时继续下一步&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；Pt=.Utility。获取点（，Msg）
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果出现错误，则&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；犯错误清除&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；退出Do&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；错误转到0时&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；pstr=替换（CStr（Pt（0）），“&quot&QUOTE&quot；）&amp&quot&引用&amp_
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；替换（CStr（Pt（1）），“&quot&QUOTE&quot；）
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；。SendCommand Chr（3）&amp；Chr（3）&amp&QUOTE_-“边界”&amp；vbCr&amp；pstr&amp；vbCr&amp；vbCr&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；设置LastObj=.ModelSpace.Item.ModelSpace.Count-1&nbsp&nbsp&nbsp&nbsp&nbsp；如果LastObj的类型是AcadLWPolyline，则&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；设置objLWPolyline（0）=LastObj&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；objLWPolyline（0）。GetBoundingBox varMinPt，varMaxPt&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；objLWPolyline（0）。删除&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；如果结束&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；转角（0）=varMinPt（0）：转角（1）=varMaxPt（1）：转角（2）=0&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；高度=2000&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；设置MTEXPOBJ=.ModelSpace。AddMText（角点，10，“50”）
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；MTEXPOBJ。高度=高度&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；MTEXPOBJ。旋转MTEXPOBJ。插入点，lineObj。角度&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；MTEXPOBJ。移动MTextObj。插入点，lineObj。终点&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；设置textObj=.ModelSpace。AddText（varArea，Pt，Height）
&039&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；text目标更新；埃克索布。更新&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp；消息=vbCrLf&amp&引用；下一个内部点或回车退出：
&nbsp&nbsp&nbsp&nbsp；循环&nbsp&nbsp&nbsp&nbsp；错误转到0时&nbsp&nbsp&nbsp&nbsp。设置变量；OSMODE；，703&nbsp&nbsp&nbsp&nbsp。设置变量；CMDECHO“；，1&nbsp&nbsp；以结尾&nbsp&nbsp；MsgBox“；“完成”
结束Sub

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