VBA基础

wannabe · 发表于 2022-7-6 17:17:35

我在VBA中的第一个练习是生成一个保存在某个位置的图形，并且在设置的坐标处有一个圆，文本位于中心。

经过几次修正后，我很快实现了我的目标，并有点自豪感。

无论如何，我决定继续我的教育，最好是使这个宏观尽可能先进一步一步。

不幸的是，我在试图修改代码以使文本居中对齐时陷入了困境。

使用“帮助”菜单，我找到了所需的代码，但无法准确地确定它需要如何实现。

那么，有人知道我需要如何安排代码吗？

ZenCad1960 · 发表于 2022-7-6 17:27:05

如果你能发布代码，那会有所帮助。

wannabe · 发表于 2022-7-6 17:41:19

好的，我把它保存在works PC上，所以明天我会做第一件事。

重要的是，我声明了字符串、高度和插入点，然后将它们全部设置好。之后，我添加了一些文本，并在末尾的括号中使用了上述值。然后，我一直在寻找在哪里添加对正，并想知道是否需要声明和设置其值。

CmdrDuh · 发表于 2022-7-6 17:45:42

这会将文字改为右对齐，应该指向大致方向

copy

Public Sub RText()
     Dim objSelected As Object
     Dim objTxt As AcadText
     Dim objSelSet As AcadSelectionSet
     Dim dblAlignmentPoint(0 To 2) As Double
     On Error GoTo ErrControl
     Dim strValue As String
     Dim N As Integer
     If ThisDrawing.SelectionSets.Count > 0 Then
           For N = 0 To ThisDrawing.SelectionSets.Count - 1
                 If ThisDrawing.SelectionSets.Item(N).Name = "TEXT" Then
                       ThisDrawing.SelectionSets("TEXT").Delete
                 End If
           Next N
     End If
     Set objSelSet = ThisDrawing.SelectionSets.Add("Text")
     objSelSet.SelectOnScreen
     For Each objSelected In objSelSet
           If TypeOf objSelected Is AcadText Then
                 Set objTxt = objSelected
                 If objTxt.Alignment = acAlignmentLeft Then
                       dblAlignmentPoint(0) = objTxt.InsertionPoint(0)
                       dblAlignmentPoint(1) = objTxt.InsertionPoint(1)
                       dblAlignmentPoint(2) = objTxt.InsertionPoint(2)
                       objTxt.Alignment = acAlignmentRight
                       objTxt.TextAlignmentPoint = dblAlignmentPoint
                 Else
                       dblAlignmentPoint(0) = objTxt.TextAlignmentPoint(0)
                       dblAlignmentPoint(1) = objTxt.TextAlignmentPoint(1)
                       dblAlignmentPoint(2) = objTxt.TextAlignmentPoint(2)
                       objTxt.Alignment = acAlignmentRight
                       objTxt.TextAlignmentPoint = dblAlignmentPoint
                 End If
           End If
     Next
     ThisDrawing.SelectionSets.Item("Text").Delete
     ThisDrawing.Application.Update
Exit_Here:
     Exit Sub
ErrControl:
     MsgBox Err.Description
     ThisDrawing.SelectionSets.Item("Text").Delete
End Sub

wannabe · 发表于 2022-7-6 17:57:59

Public Sub NewDrgCircleText（）
此图纸。应用文件。添加
Dim CirinsPoint（0到2）作为Double“声明圆的插入点
Dim CirRad As Double'表示圆的半径
Dim Cir As AcadCircle“声明圆对象”
Dim textHeight As Double'声明文字高度
Dim textStr As String'声明文本字符串
Dim textObj As AcadText'声明文本对象
Dim textAlign As Double'声明文本对齐
CirinsPoint（0）=500’设置插入点x坐标
CirinsPoint（1）=500’设置插入点y坐标
CirinsPoint（2）=0'设置插入点z坐标
CirRad=50’设置圆的直径
text高度=5’将文本高度设置为20.0
textStr=“DS1000”'设置文本字符串
'创建圆形对象
设置Cir=ThisDrawing。模型空间。AddCircle（CirinsPoint，CirRad）
'创建文本对象
设置textObj=ThisDrawing。模型空间。AddText（textStr、CirinsPoint、textHeight）
文本对象。对齐=A对齐居中

'将图形保存到桌面
此图纸。另存为（“C:\Documents and Settings\39925nt\Desktop\DS1000.dwg”）
末端接头

以上是我试图整理的基本代码。如果错误显而易见，那么请指出，因为这是我第一次真正尝试。

我遇到的问题是，与对齐其插入点的文本中间中心相反，它没有正确对齐，而是将插入点设置为图形原点（0,0）。

谁能告诉我怎么了？

干杯

wannabe · 发表于 2022-7-6 18:05:56

我终于破解了它：

thoug，我显然需要整理并删除不必要的代码行。

wannabe · 发表于 2022-7-6 18:12:07

***编辑：请参阅下一篇文章***

完成了我的基本要求（在这个论坛的帮助下），我为自己设定了当前项目的新要求。

我想要实现的是创建一种新的文本样式，并将字体设置为arial。然后，需要将先前创建的文本（DS1000）添加到该样式中。

花了大约一两个小时尝试不同的方法来实现这一点，我在为新样式（我希望是Arial）设置字体时遇到了麻烦。

不幸的是，内置的帮助有时不如你们有用；有谁能帮忙吗？

以下是我当前的代码：

wannabe · 发表于 2022-7-6 18:24:19

***编辑***创建新文本样式后立即将其设置为活动文本样式有效，但我仍想知道是否可以将某些文本的文本样式设置为已创建但不一定是活动样式的样式。

好的，我想我现在就到了。

在创建了下一个文本样式并分配了保存在AutoCAD fonts文件夹中的字体样式后，我仍然不太明白如何选择其他字体，如Arial，这些字体不存储在fonts文件夹中。某些字体文件是否包含多种字体样式？如果是，我该如何告诉VBA找到它们？

干杯

当前代码：

[编程交流] VBA基础

发表回复

精选推荐