|
|
发表于 2006-1-24 21:39:00
|
显示全部楼层
哈哈。。是的。。电气原理图。。我是做成套设备的。。温州这里的。
具体的方法找不到。。现在只能用另一个麻烦些的办法来实现。
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.Value 0 Then
rstr = ""
rstr = ThisDrawing.Utility.GetString(2, NL & "是否重复插入{" & strFilePath & "}?[Y]:")
If rstr = "" Then GoTo fun
End If
UserForm1.Show
End Sub
======================================================
插入外部块后。。。直接利用。。trim来删除中间的那部分的线。。点几下的事。。哈哈。。其它的方法目前还没有想到。。
|
|
置顶卡
