问一个关于VBA处理...线与块的问题.

lijinjie

像上面的程序..我希望用..VBA把..那个外部插入时..自动..把中间的线给分开成2段...达到下面那个图的效果.......再把..2段线..分另接到..这个块的..两端.

希望老大帮忙一下..

MJTD_7777

是画气路图吗？哈哈,同道中人.

lijinjie

哈哈。。是的。。电气原理图。。我是做成套设备的。。温州这里的。

具体的方法找不到。。现在只能用另一个麻烦些的办法来实现。

 

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来删除中间的那部分的线。。点几下的事。。哈哈。。其它的方法目前还没有想到。。

 

lijinjie

二次开发专门用于。。电气原理图。。自己感觉和其它专业版本。。有的一比。。哈哈。