Question

有关CAD VBA填充的问题？

sub 填充（）
On Error GoTo err
Dim hatchObj As AcadHatch
Dim patternName As String
Dim PatternType As Long
Dim bAssociativity As Boolean
Dim outerLoop(0) As AcadEntity ' 定义图案填充
patternName = "solid"
PatternType = 0
bAssociativity = True
Set hatchObj = acaddoc.ModelSpace.AddHatch(PatternType, patternName, bAssociativity) ' 当前图纸的实体数目
Dim Pt As Variant
Pt = acaddoc.Utility.GetPoint(, "指定内部点: ") **********在这里，这个点是运行程序后，自己拾取的一个点，我现在想变为自己给定的一个点，就是想自己在这里定义一个点，然后给这个点赋值，不知道要用什么么命令，我是新手！！
acaddoc.SendCommand "_-Boundary" & vbCr & Pt(0) & "," & Pt(1) & vbCr & vbCr ' 如果存在边界，则会生成新的实体
Set outerLoop(0) = acaddoc.ModelSpace.Item(acaddoc.ModelSpace.Count - 1)
hatchObj.AppendOuterLoop outerLoop ' 计算并显示图案填充
hatchObj.Evaluate
acaddoc.Regen True
outerLoop(0).Delete
acaddoc.Regen True
err:
end sub

Answer 1

不知道你读取出来的文字是放在哪里？即读到哪个程序中的？可以从该程序入手考虑问题。譬如若是读到excel中的，则直接添加excel中排序的代码，试着从这方面考虑吧。
既已读到了TXT中了，就不必再考虑VBA了。除非你一开始读写的时候就开始了排序。否则，等全部都写入TXT中以后，就没法再用VBA实现了。（除非用VBA将已写入的TXT全部删除。）

Answer 2

给你看个我才写的，插入文件
需要抓点，要有文件才行，

Sub Linkblok()
On Error GoTo Err
Dim Po(0 To 2) As Double
Dim Pr(0 To 2) As Double
Dim Var As Variant
Dim BlokIn As AcadBlockReference
Dim BlokName As String
Dim Ang As Double
Dim LDob As Double
Dim XDob As Double

Dim UcsObj As AcadUCS
Dim Origin(0 To 2) As Double
Dim XAxisPo(0 To 2) As Double
Dim YAxisPo(0 To 2) As Double

Origin(0) = 0#: Origin(1) = 0#: Origin(2) = 0#
XAxisPo(0) = 3: XAxisPo(1) = 0: XAxisPo(2) = 0
YAxisPo(0) = 0: YAxisPo(1) = 3: YAxisPo(2) = 0
Set UcsObj = ThisDrawing.UserCoordinateSystems.Add(Origin, XAxisPo, YAxisPo, "WUCS")
ThisDrawing.ActiveUCS = UcsObj

BlokName = ThisDrawing.Utility.GetString(False, vbCr & "输入的块名<" + BlockNameSt + ">: ")

If BlokName <> "" Then
BlockNameSt = BlokName
Else
BlokName = BlockNameSt
End If

BlokName = "D:\CAD块\" + BlokName + ".dwg" ‘设定一个路径

If Dir(BlokName) <> "" Then

Do

Var = ThisDrawing.Utility.GetPoint(, vbCr & "选取图块放置点:")
Po(0) = Var(0): Po(1) = Var(1): Po(2) = Var(2)
Set BlokIn = ThisDrawing.ModelSpace.InsertBlock(Po, BlokName, 1, 1, 1, 0)

Var = ThisDrawing.Utility.GetPoint(Po, vbCr & "指定图块方向:")
Pr(0) = Var(0): Pr(1) = Var(1): Pr(2) = Var(2)
XDob = Pr(0) - Po(0)
LDob = Sqr(((Pr(0) - Po(0)) * (Pr(0) - Po(0))) + ((Pr(1) - Po(1)) * (Pr(1) - Po(1))))
Ang = XDob / LDob

If Pr(1) > Po(1) Then
Ang = Atn(-Ang / Sqr(-Ang * Ang + 1)) + 2 * Atn(1)
End If
If Pr(1) < Po(1) Then
Ang = -Atn(-Ang / Sqr(-Ang * Ang + 1)) + 2 * Atn(1) - 180 * 3.1415926 / 180
End If
If Pr(1) = Po(1) And Pr(0) < Po(0) Then
Ang = 180 * 3.1415926 / 180
End If
If Pr(1) = Po(1) And Pr(0) > Po(0) Then
Ang = 0
End If

BlokIn.Rotate Po, Ang

Loop

Else
ThisDrawing.Utility.Prompt vbCr & BlokName + "的文件路径不存在!"
End If

Err:

End Sub

Answer 3

使用Utility.GetPoint方法是可以直接在屏幕点取一个点，也可以直接在命令行输入坐标值的，绝对坐标或相对坐标，就像CAD的基本命令一样了，比如@89，33，我认为没必要改。当然也可以用Utility的GetReal或是GetString方法，但那就要麻烦一点得多写点代码来处理。