OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   how to find X,Y position of the point where 2 objects touches (http://forum.oberonplace.com/showthread.php?t=24797)

aakkaarr 24-06-2017 14:57

how to find X,Y position of the point where 2 objects touches
 
1 Attachment(s)
how to find X,Y position of the point where 2 objects touches

shark 28-06-2017 02:35

example from CorelDRAW VBA Help
 
Code:

Sub Test()
Dim sr As ShapeRange
Dim sp1 As SubPath, sp2 As SubPath
Dim cps As CrossPoints, cp As CrossPoint
Dim x As Double, y As Double, n As Long

 Set sr = ActiveSelectionRange
 If sr.Count <> 2 Then
    MsgBox "Please select two curves", vbCritical
    Exit Sub
 End If

 If sr(1).Type <> cdrCurveShape Or sr(2).Type <> cdrCurveShape Then
    MsgBox "One of the selected shapes is not a curve", vbCritical
    Exit Sub
 End If

 n = 0

 For Each sp1 In sr(1).Curve.Subpaths
  For Each sp2 In sr(2).Curve.Subpaths
  Set cps = sp1.GetIntersections(sp2)
  For Each cp In cps
    ActiveLayer.CreateEllipse2 cp.PositionX, cp.PositionY, 0.05
  Next cp
  n = n + cps.Count
  Next sp2
 Next sp1

 MsgBox n & " intersection point(s) found"
End Sub


aakkaarr 09-07-2017 12:24

The example does not work with the objects touching not inersecting
 
The example does not work with the objects touching not intersecting

ager 24-10-2017 22:06

sorry for the late answer
 
Code:

Sub touch()
Dim sr As ShapeRange, s As Shape, i As Long, k As Long, Xi As Double, Yi As Double
Set sr = ActiveSelectionRange
If sr.Count <> 2 Then Exit Sub
Set s = sr(1).Weld(sr(2))

With s.Curve
For i = 1 To .Nodes.Count
    For k = i + 1 To .Nodes.Count
        If .Nodes(i).GetDistanceFrom(.Nodes(k)) = 0 Then
            Xi = .Nodes(i).PositionX: Yi = .Nodes(i).PositionY
            ActiveLayer.CreateEllipse2 Xi, Yi, 0.02
        End If
    Next k
Next i
End With

End Sub


aakkaarr 08-01-2018 03:20

Thank you very much
 
Thank you very much


All times are GMT -5. The time now is 15:59.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com