Create point on a 3D circle

[OceanaPolynom]

Hello

I wrote some code (with your help) that draws 3D circles when given the center point of the circle and the direction perpendicular to the plane of the circle.  I now want to create points along the circle.  This is it so far:

    rstObj.MoveFirst
    For i& = 1 To rstObj.RecordCount
        y# = rstObj!cly
        x# = rstObj!clx
        z# = rstObj!clz
        nn# = rstObj!clDirection
        cc# = rstObj!clchain
        ' Define the UCS points
        origin(0) = y#: origin(1) = x#: origin(2) = z# + al(TextBoxElevationOffset)
        xAxisPnt(0) = origin(0) + Sin(nn# + Pi# / 2) * 100: xAxisPnt(1) = origin(1) + Cos(nn# + Pi# / 2) * 100: xAxisPnt(2) = z# + hc#
        yAxisPnt(0) = origin(0): yAxisPnt(1) = origin(1): yAxisPnt(2) = 100
    ' Add the UCS to the  UserCoordinatesSystems collection
    Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "New_UCS")
    ' Display the UCS icon
    ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
    ThisDrawing.ActiveViewport.UCSIconOn = True

    ' Make the new UCS the active UCS
    ThisDrawing.ActiveUCS = ucsObj
    'Draw the ring with the chainage text
    Set circObj = ThisDrawing.ModelSpace.AddCircle(origin, rr#)
    Set txtObj = ThisDrawing.ModelSpace.AddText(Format(cc#, "######0.00"), origin, 0.2)
    
'here is my code that doesn't work

    '01 14 2018
    'create points on the ring
    ang# = 0: dang# = 15 * Pi# / 180
    For jj% = 1 To 24
        yp# = origin(0) + Sin(ang#) * rr#: xp# = origin(1) + Cos(ang#) * rr#: zp# = origin(2) + Sin(ang#) * rr#
      
 'insertionPnt(0) = yp#
 'insertionPnt(1) = xp#
 'insertionPnt(2) = zp#
 'Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "pt250", 1#, 1#, 1#, 0)
 '   ' Get the attributes for the block reference
 '   varAttributes = blockRefObj.GetAttributes
 '   'blockrefobject.
 '   varAttributes(0).TextString = Format(cc#, "#####0.00")
 '   varAttributes(1).TextString = Format(zp#, "#####0.000")
       
        ang# = ang# + dang#
    Next jj%
    
    'end addition
    
    rstObj.MoveNext
    Next i&

Any help will be gratefully appreciated

John

[Anonymous]

Give details about your actual issue

Meanwhile, maybe

zp# = origin(2) + Sin(ang#) * rr#

should be

zp# = origin(2)

[OceanaPolynom]

Hello

Thanks for you answer.  Your suggestion  does not seem to work, see the attached jpeg.  The code that I am working on is for a tunneling job.  So far I am using it to create reports.  Now I need to create reports from a cloud of points from a laser scanner.  Presently we measure about 24 points (using a  total station) around any ring in question.  The software then calculates many (about a 1000) circles.  The average circle is then used to make an As Made report.  Instead of measuring the points with a total station I need to interpolate the 24 points from the scanned data.  In the past I wrote a similar program that used the scanned data from a multi-beam sonar scanner.  I successfully worked with a few 10's of millions of points, which is enough to do a reasonable number of rings at once.  I am stuck trying to create the points.

Thank you

John

[OceanaPolynom · Accepted solution]

I adapted this code and it worked very well.  It assumes that a block named pt250 exists in the drawing.  I wish I knew more math.

Private Sub CommandButtonMeasure_Click()
'https://groups.google.com/forum/#!topic/autodesk.autocad.customization.vba/gjb96_YG0Bw
' This is the way to pass the measure command parameters to the send command
Dim ent As AcadEntity
Dim str As String
Dim str1 As String
Dim strclose As String

For Each ent In ThisDrawing.ModelSpace
    If TypeOf ent Is AcadCircle Then
        Set tmpObj = ent
        str1 = "(handent """ + tmpObj.Handle + """" + ")"

        str = "_measure "
        str = str & str1 & vbCr & "block" & vbCr & "pt250" & vbCr & "Yes" & vbCr & "1.00" & vbCr
        Application.ActiveDocument.SendCommand (str)

    End If
Next



End Sub

[SEANT61 · Accepted solution]

This would be a way of accomplishing the task with less of a reliance on "SendCommand".

Sub AddPointsToCircle()
Const PI = 3.141592654
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim varStart As Variant

Dim intCircQuantity As Integer

Dim arrPoint(2) As Double
Dim varNormal As Variant
Dim varStartPoint As Variant
Dim Circ As AcadCircle

Dim dblRads As Double
Dim intStep As Integer
Dim intDivs As Integer
With ThisDrawing

   On Error GoTo Abort
   intDivs = .Utility.GetInteger("Input number of circle divisions: ")
   On Error GoTo 0

    intCode(0) = 0
    varData(0) = "CIRCLE"
    intCircQuantity = SoSSS(intCode, varData)
    dblRads = PI * 2 / intDivs
    If intCircQuantity > 0 Then
       For Each Circ In ThisDrawing.SelectionSets.Item("TempSSet")
            varNormal = Circ.Normal
            varStartPoint = .Utility.TranslateCoordinates(Circ.Center, acWorld, acOCS, 0, varNormal)
            For intStep = 0 To (intDivs - 1)
                arrPoint(0) = (Circ.Radius * Cos(dblRads * intStep)) + varStartPoint(0)
                arrPoint(1) = (Circ.Radius * Sin(dblRads * intStep)) + varStartPoint(1)
                arrPoint(2) = varStartPoint(2)
                varStart = .Utility.TranslateCoordinates(arrPoint, acOCS, acWorld, 0, varNormal)
                .ModelSpace.AddPoint (varStart)
            Next
       Next
    End If
Abort:
End With
End Sub


Sub SSClear()
Dim SSS As AcadSelectionSets
   On Error Resume Next
   Set SSS = ThisDrawing.SelectionSets
      If SSS.Count > 0 Then
         SSS.Item("TempSSet").Delete
         SSS.Item("RemoveSSet").Delete
         SSS.Item("EntireSS").Delete
      End If
End Sub

Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
   Dim TempObjSS As AcadSelectionSet
   SSClear
   Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
         'pick selection set
   If IsMissing(grpCode) Then
      TempObjSS.SelectOnScreen
   Else
      TempObjSS.SelectOnScreen grpCode, dataVal
   End If
   SoSSS = TempObjSS.Count
End Function

[OceanaPolynom]

This is a much better solution.  Thank you very much.

John

[andriamparany.ralambomahay]

Thanks, it helps