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

lijinjie 发表于 2006-1-20 00:32:00

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

MJTD_7777 发表于 2006-1-24 16:59:00

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

lijinjie 发表于 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 & "}?:")       If rstr = "" Then GoTo fun    End If       UserForm1.Show
 End Sub
======================================================
插入外部块后。。。直接利用。。trim来删除中间的那部分的线。。点几下的事。。哈哈。。其它的方法目前还没有想到。。

lijinjie 发表于 2006-1-24 21:45:00

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

页: [1]

明经CAD社区's Archiver

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