问一个关于VBA处理...线与块的问题.
像上面的程序..我希望用..VBA把..那个外部插入时..自动..把中间的线给分开成2段...达到下面那个图的效果.......再把..2段线..分另接到..这个块的..两端.
希望老大帮忙一下..
是画气路图吗？哈哈,同道中人.
哈哈。。是的。。电气原理图。。我是做成套设备的。。温州这里的。
具体的方法找不到。。现在只能用另一个麻烦些的办法来实现。
Public Sub addWblock(strFilePath As String)
On Error Resume Next
Dim InsertPoint As Variant
Dim x, y, z As Double
Dim myblock As AcadBlockReference
Dim rstr As String
Dim pos As Variant
Dim tempstr As String
fun:
x = 1
y = 1
z = 1
NL = Chr(13) & Chr(10)
UserForm1.Hide
InsertPoint = ThisDrawing.Utility.GetPoint(, NL)
Set myblock = ThisDrawing.ModelSpace.InsertBlock(InsertPoint, strFilePath, x, y, z, 0, "")
myblock.Update
GetCursorPos (pos)
' If (strFilePath = "交叉点(跨越).dwg") Or (strFilePath = "交叉点(竖直).dwg") Or (Left$(strFilePath, 4) = "(开关)") Or (Left$(strFilePath, 2) = "按钮") Then
Dim pnt1 As Variant
Dim entObj1 As AcadEntity
' ThisDrawing.Utility.GetEntity entObj1, pnt1, "选择图元："
Dim det1 As String
entObj1 = myblock
det1 = axEnt2lspEnt(entObj1)
Dim Pnt2 As Variant
Dim entObj2 As AcadEntity
' ThisDrawing.Utility.GetEntity entObj2, Pnt2, "选择被剪图元："
Dim det2 As String
det2 = GetDoubleEntTable(entObj2, InsertPoint)
ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr
' End If
'ThisDrawing.Utility.Prompt "插入外部块>>" + strFilePath
'-------------------------------------
'重复插入
'-------------------------------------
If UserForm1.CheckBox1.Value0 Then
rstr = ""
rstr = ThisDrawing.Utility.GetString(2, NL & "是否重复插入{" & strFilePath & "}?:")
If rstr = "" Then GoTo fun
End If
UserForm1.Show
End Sub
======================================================
插入外部块后。。。直接利用。。trim来删除中间的那部分的线。。点几下的事。。哈哈。。其它的方法目前还没有想到。。
二次开发专门用于。。电气原理图。。自己感觉和其它专业版本。。有的一比。。哈哈。
页:
[1]