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

VBA基础

我在VBA中的第一个练习是生成一个保存在某个位置的图形,并且在设置的坐标处有一个圆,文本位于中心。
 
经过几次修正后,我很快实现了我的目标,并有点自豪感。
 
无论如何,我决定继续我的教育,最好是使这个宏观尽可能先进一步一步。
 
不幸的是,我在试图修改代码以使文本居中对齐时陷入了困境。
 
使用“帮助”菜单,我找到了所需的代码,但无法准确地确定它需要如何实现。
 
那么,有人知道我需要如何安排代码吗?

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

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

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

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

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

这会将文字改为右对齐,应该指向大致方向
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找到它们?
 
干杯
 
当前代码:
 
页: [1]
查看完整版本: VBA基础