Use Break & Trim command in VBA program

[randaff2005]

hi, i was tried to create vba program, and i have the problem for using trim & break command , any somebody to help my problem..?

thx
Haris randaff

[rcrabb]

to my knowledge there is no Trim command in VBA, you either have to use a sendcommand(not recommended) or find a different solution .... perhaps you could post an example of what you are trying to do?

[randaff2005]

i will to create a block symbol and it can trim automatically on the line object

[fixo]

i will to create a block symbol and it can trim automatically on the line object
See if it will work for you
Not exactly what you wanted though
but may helps
Use it after your blocks would be inserted
Hth

~'J'~



Sub BreakForBlock()
Dim fpt As Variant, spt As Variant
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim osm As Integer
Dim strp1 As String, strp2 As String
ftype(0) = 0: fdata(0) = "LINE"
Dim dxftype As Variant, dxfdata As Variant
dxftype = ftype: dxfdata = fdata
Dim ss As AcadSelectionSet

On Error GoTo Err_Control

Set ss = ThisDrawing.PickfirstSelectionSet
ss.Clear
With ThisDrawing
osm = .GetVariable("OSMODE")
.SetVariable "OSMODE", 32 '// <-- change to your needs
fpt = .Utility.GetPoint(, "Pick first point")
ss.Select acSelectionSetCrossing, fpt, fpt, dxftype, dxfdata
If ss.Count = 1 Then
ss.Highlight True
Else
MsgBox Chr(9) & "0 objects selected OR " & vbNewLine & _
"incorrect number of objects selected..."
GoTo Exit_Here
End If
spt = .Utility.GetPoint(, "Pick second point")
End With

Dim ln As AcadLine
Dim oent As AcadEntity
Set oent = ss.Item(0)
Set ln = oent
Dim strh As String
strh = ln.Handle
strp1 = Replace(CStr(fpt(0)), ",", ".") & "," & _
Replace(CStr(fpt(1)), ",", ".") & "," & _
Replace(CStr(fpt(2)), ",", ".")
strp2 = Replace(CStr(spt(0)), ",", ".") & "," & _
Replace(CStr(spt(1)), ",", ".") & "," & _
Replace(CStr(spt(2)), ",", ".")
ThisDrawing.SetVariable "CMDECHO", 0
ThisDrawing.SendCommand "-OSNAP NONE "
ThisDrawing.SendCommand "_BREAK " & _
"(handent " & Chr(34) & strh & Chr(34) & ")" & _
vbCr & strp1 & vbCr & strp2 & vbCr

Exit_Here:
ss.Highlight False
ss.Clear
With ThisDrawing
.Regen acActiveViewport
.SetVariable "OSMODE", 512
.SetVariable "CMDECHO", 1
End With

Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
Resume Exit_Here
End If

End Sub

[Mlabell]

See if it will work for you
Not exactly what you wanted though
but may helps
Use it after your blocks would be inserted
Hth

~'J'~


First of all much thanks for posting this code. I have modified it to reprompt the user to select a first point if it is not on an object. Also removed the "ss.Highlight False" in Exit_Here because if the user seleceted an entire line to be broke, the program would keep on throwing up a message box which could not be closed except by killing acad.exe in the task manager.




Sub BreakForBlock()
Dim fpt As Variant, spt As Variant
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim strp1 As String, strp2 As String
ftype(0) = 0: fdata(0) = "LINE"
Dim dxftype As Variant, dxfdata As Variant
dxftype = ftype: dxfdata = fdata
Dim ss As AcadSelectionSet

On Error GoTo Err_Control

Set ss = ThisDrawing.PickfirstSelectionSet
ss.Clear
With ThisDrawing
First_Point:
fpt = .Utility.GetPoint(, "Pick first point")
ss.Select acSelectionSetCrossing, fpt, fpt, dxftype, dxfdata
If ss.Count = 1 Then
ss.Highlight True
Else
MsgBox Chr(9) & "0 objects selected OR " & vbNewLine & _
"Incorrect number of objects selected..."
GoTo First_Point
End If
spt = .Utility.GetPoint(, "Pick second point")
End With
Dim ln As AcadLine
Dim oent As AcadEntity
Set oent = ss.Item(0)
Set ln = oent
Dim strh As String
strh = ln.Handle
strp1 = Replace(CStr(fpt(0)), ",", ".") & "," & _
Replace(CStr(fpt(1)), ",", ".") & "," & _
Replace(CStr(fpt(2)), ",", ".")
strp2 = Replace(CStr(spt(0)), ",", ".") & "," & _
Replace(CStr(spt(1)), ",", ".") & "," & _
Replace(CStr(spt(2)), ",", ".")
ThisDrawing.SendCommand "_BREAK " & _
"(handent " & Chr(34) & strh & Chr(34) & ")" & _
vbCr & strp1 & vbCr & strp2 & vbCr
Exit_Here:
ss.Clear
With ThisDrawing
.Regen acActiveViewport
End With

Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
Resume Exit_Here
End If
End Sub

[fixo]

You're quite welcome
Glad you resolved them to suit

~'J'~