Тема: Как разделить объект на две части по линии?

Ребята, можно ли сделать такую вещь: есть какой-либо объект и есть линия его пересекающая. И надо, разделить этот объект на две части по этой линии. Это что-то типа trim, но trim оставляет только одну часть объекта. И я не нашел даже в VBA собственно этот метод trim, есть ли он вообще? Спасибо.

Re: Как разделить объект на две части по линии?

_.break в совпадающих точках.

Re: Как разделить объект на две части по линии?

Так а если объектом к примеру является штриховка? Тут уже break не прокатывает.

Re: Как разделить объект на две части по линии?

> Timur
Попробуй для штриховки
Ограничения:
исходный контур штриховки должен представлять
собой замкнутую полилинию
Если будет состоять из отдельных примитивов то
работать не будет
Выбираешь штриховку, затем после ее удаления
указываешь 2 точки контура, используя привязки

Option Explicit
Const pi As Double = 3.14159265358979
Public Sub DivideHatch()
Dim sset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oHatch As AcadHatch
Set sset = ThisDrawing.PickfirstSelectionSet
sset.Clear
Dim fcode(0) As Integer
Dim fdata(0) As Variant
Dim dxfcode, dxfdata
fcode(0) = 0
fdata(0) = "HATCH"
dxfcode = fcode
dxfdata = fdata
sset.SelectOnScreen dxfcode, dxfdata
If sset.Count = 0 Then
MsgBox "Nothing selected"
End If
If sset.Count > 1 Then
MsgBox "More than one hatch selected"
Exit Sub
End If
Set oEnt = sset.Item(0)
Set oHatch = oEnt
'//
Dim hatLayer As String
Dim patName As String
Dim patType As Long
Dim blnAssoc As Boolean
Dim hatScale As Double
Dim hatAngle As Double
Dim hatCol As Integer
'//
hatLayer = oHatch.Layer
patName = oHatch.patternName
patType = oHatch.PatternType
blnAssoc = oHatch.AssociativeHatch
hatScale = oHatch.PatternScale
hatAngle = oHatch.PatternAngle
hatCol = oHatch.color
'//
oHatch.Delete
'//
Dim p1, p2
With ThisDrawing.Utility
p1 = .GetPoint(, vbCrLf & "Pick the first point: ")
p2 = .GetPoint(p1, vbCrLf & "Pick the second point: ")
'//
Dim mp(2) As Double
mp(0) = (p1(0) + p2(0)) / 2: mp(1) = (p1(1) + p2(1)) / 2: mp(2) = 0#
Dim ang1 As Double, ang2 As Double
ang1 = .AngleFromXAxis(p1, p2) + pi / 2
ang2 = .AngleFromXAxis(p1, p2) - pi / 2
'//
Dim hp1, hp2
hp1 = .PolarPoint(mp, ang1, 1#)
hp2 = .PolarPoint(mp, ang2, 1#)
Dim oLine As AcadLine
Set oLine = ThisDrawing.ModelSpace.AddLine(p1, p2)
'//
Dim oHatch1 As AcadHatch
Dim oHatch2 As AcadHatch
Set oHatch1 = DrawHatch(hp1, hatLayer, patName, patType, blnAssoc, hatScale, hatAngle, hatCol)
Set oHatch2 = DrawHatch(hp2, hatLayer, patName, patType, blnAssoc, hatScale, hatAngle + pi / 2, hatCol)
'//
oLine.Delete
'//
End With
'//
End Sub
' borrowed from the Help file
Public Function DrawHatch(intPt As Variant, hatLayer As String, patName As String, patType As Long, blnAssoc As Boolean, _
hatScale As Double, hatAngle As Double, hatCol As Integer) As AcadHatch
' This example creates an associative hatch in model space.
Dim hatchObj As AcadHatch
On Error GoTo Err_Control
' Create the associative Hatch object in model space
Set hatchObj = ThisDrawing.ModelSpace.AddHatch(patType, patName, blnAssoc)
' add properties
hatchObj.Layer = hatLayer
hatchObj.AssociativeHatch = blnAssoc
hatchObj.PatternScale = hatScale
hatchObj.PatternAngle = hatAngle
hatchObj.color = hatCol
' Create the outer boundary for the hatch
Dim ObjLast As AcadEntity
Dim i As Integer
'Dim intPt As Variant
Dim pstr As String
Dim outerLoop(0) As AcadEntity
i = ThisDrawing.ModelSpace.Count - 1
'intPt = ThisDrawing.Utility.GetPoint(, "Pick the inner point of boundary")
pstr = Replace(CStr(intPt(0)), ",", ".") & "," & Replace(CStr(intPt(1)), ",", ".")
ThisDrawing.SendCommand Chr(3) & Chr(3) & "-boundary" & vbCr & pstr & vbCr & vbCr
Set ObjLast = ThisDrawing.ModelSpace.Item(i + 1)
Set outerLoop(0) = ObjLast
' Append the outerboundary to the hatch object, and display the hatch
hatchObj.AppendOuterLoop (outerLoop)
hatchObj.Evaluate
' delete boundary
ObjLast.Delete
ThisDrawing.Regen True
Set DrawHatch = hatchObj
Err_Control:
End Function

~'J'~

Re: Как разделить объект на две части по линии?

> Fatty
Спасибо большое за программу. Правда там нет автоматического вычисления координат для двух точек внутренних контуров (я использавол строку 'intPt = ThisDrawing.Utility.GetPoint(, "Pick the inner point of boundary") ) , но это не проблема для меня, сам придумаю.  Вот если бы она еще работала для штриховок у которых исходные контуры образованы сплайнами...

Re: Как разделить объект на две части по линии?

> Timur
Со сплайнами работать не будет никак
~'J'~

Re: Как разделить объект на две части по линии?

Может подскажете как командой break резать объекты. Допустим есть замкнутая полилиния(рамка) и необходимо разрезать (но не удалять) все те объекты которые выступают за границы рамки.

Re: Как разделить объект на две части по линии?

> Maxim
В Express Tools есть команда EXTRIM
на VBA запаришься такое писать :)
~'J'~

Re: Как разделить объект на две части по линии?

Спасибо. А нельзя чтобы он обекты не удалял, а только резал.

Re: Как разделить объект на две части по линии?

Я делаю так:
Рисую прямоугольник (rectang) минимальной ширины (правда когда ширина очень мала не получается), затем _extrim и прямоугольник удаляю. Если нужно деление по линии (без разрыва) то приходиться рисовать линию по центру прямоугольника, удалять прямоугольник и затем _extend.
Может и многодельно но не так часто приходится делать такую работу.

Re: Как разделить объект на две части по линии?

а команда trim то есть или нет в ВБА?