• Options
• Login
• Registrati
• Desktop Style
• Accelerated Mobile Pages Theme

MACRO PER MODIFICA CERCHI O ELISSI - Forum NANOCAD Italia

• Index

  • Forum NANOCAD Italia
  • NANOCAD ... ed altro ancora
  • Programmazione in nanoCAD
  • MACRO PER MODIFICA CERCHI O ELISSI
• MACRO PER MODIFICA CERCHI O ELISSI

• MACRO PER MODIFICA CERCHI O ELISSI

  Alberto_Broggian > 10-25-2024, 07:07 AM

  Ciao a tutti,
  vi pongo un quesito: ho la necessità per la preparazione al taglio di convertire dei fori (cerchi o elissi) in un piano di taglio.
  Dunque devo suddividere il "cerchio" che di solito è uno sviluppo di un foro come da immagine 
  è fattibile con una macro?

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  tracciatura.net > 10-28-2024, 12:53 PM

  Sicuramente si,
  ma non ho capito cosa vuoi fare
  prova a scriverlo come se lo spiegassi ad un bambino

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  Alberto_Broggian > 10-28-2024, 04:04 PM

  Piacere di conoscerti, apprezzo molto il sito di cui porti il nome.
  Cercherò di spiegare semplice semplice.
  input di partenza: 
  -selezione del cerchio, elisse e/o spline
  -definizione del lato di calandratura del foro
  -definizione della distanza dai due poli generati dalla direzione di calandratura (per definire l'inizio e fine della suddivisione)
  -ripartizione in segmenti approssimati secondo 2 dati ( valore linea - valore spazio)
  -applicazione di una linea a valore fisso perpendicolare ai terminali delle prime su direzione interna al cerchio.
  credo non ci sia altro.

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  tracciatura.net > 11-04-2024, 09:16 AM

  Forse sono arrivato a capire cosa ti serve ...
  vuoi lasciare delle "tacche" cioè lasciare la scarto di un foro per calandrarlo per poi ritagliarlo successivamente
  ho avuto l'occasione di usare ActCut (programma per pantografo della ALMAITALIA) e c'era la funzione che lasciava le tacche mediante click manuale direttamente sulla sagoma, non c'è nel programma che usi?

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  Alberto_Broggian > 11-06-2024, 02:44 PM

  bravo! , io non sono direttamente il fornitore taglio laser e nn ho programmi di nesting ne di preparazione al taglio,
  però devo cercare di dare i file dxf al taglio il più definitivi possibili xchè altrimenti è un errore continuo!
  chi taglia carica il file e non ne vuole sapere di altro

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  tracciatura.net > 11-06-2024, 03:58 PM

  ok
  provo a darci un occhio
  quando ho tempo

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  tracciatura.net > 11-25-2024, 05:02 PM

  Ok
  ho fatto quella per il cerchio,
  per l'ellissi devo vedere come fare,
  per la spline la vedo dura
  ma al momento le ho fatte come macro di autoCAD devo convertirle in nanoCAD

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  tracciatura.net > 11-27-2024, 09:20 PM

  questa macro che è scritta per AutoCAD funziona per il cerchio indicando l'asse di calandratura orizzontale o verticale
  ora mi trovo in UK e non riesco ad attivare NanoCAD quindi deve essere adattata per nanoCAD
  queste le impostazioni
  
  '******************************
  'Impostazioni
  '******************************
  AsseCalOrizzontale = True
  AsseCalOrizzontale = False
  Fascia = 250    'mm pezzo nella direzione della calandratura
  Passo = 100
  Tacca = 10
  Taglio = 20
  '******************************
  
  AsseCalOrizzontale = True indica Asse Calandratura Orizzontale
  AsseCalOrizzontale = False indica Asse Calandratura Verticale
  eliminare la riga che non interessa
  
  

  Codice:

  Option Explicit


Public Sub Tacche()
Dim EntObj As AcadEntity
Dim AsseCalOrizzontale As Boolean
Dim cirObj As AcadCircle
Dim lineObj As AcadObject
Dim arcObj As AcadArc
Dim Fascia, Passo, Tacca, Taglio
Dim nPassi
Dim ang1, ang2, AngRif1, AngRif2
Dim cenPnt(0 To 2) As Double
Dim pnt(0 To 2) As Double
Dim Pg
Dim tmp1, tmp2
Dim c

   Pg = 4 * Atn(1)

   AppActivate ThisDrawing.Application.Caption
   
   ' Create the selection set
   Dim ssetObj As AcadSelectionSet
   Set ssetObj = ThisDrawing.SelectionSets.Add("SSET" & Rnd(100) * Time)
   
   ' Add objects to a selection set by prompting user to select on the screen
   ssetObj.SelectOnScreen
   
   If (ssetObj.Count <> 1) Then
       Debug.Print "Attenzione più di un oggetto selezionato"
       End
   End If
   
   Set EntObj = ssetObj(0)
   Debug.Print EntObj.ObjectName
   If EntObj.ObjectName = "AcDbCircle" Then
       GoTo Circle_
   Else
       Debug.Print "Non è un cerchio"
       End
   End If
       
Circle_:

Set cirObj = EntObj


'******************************
'Impostazioni
'******************************
AsseCalOrizzontale = True
AsseCalOrizzontale = False
Fascia = 250    'mm pezzo nella direzione della calandratura
Passo = 100
Tacca = 10
Taglio = 20
'******************************


If (AsseCalOrizzontale) Then
   AngRif1 = Pg / 2
   AngRif2 = Pg * 1.5
Else
   AngRif1 = 0
   AngRif2 = Pg
End If

'In base alla circonferenza arrotondo il passo
Debug.Print "Circumference->" & cirObj.Circumference
Debug.Print "Passo->" & Passo
tmp1 = (cirObj.Circumference - 2 * (Fascia + Tacca)) / (Passo + Tacca)
nPassi = Int(tmp1 / 2) * 2
Passo = (cirObj.Circumference - 2 * (Fascia + Tacca)) / nPassi - Tacca
Debug.Print "NuovoPasso->" & Passo


cirObj.color = acMagenta
'Fascia superiore
tmp1 = (Fascia / 2) / (cirObj.Circumference / (2 * Pg))
ang1 = AngRif1 - tmp1
ang2 = AngRif1 + tmp1
Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
pnt(0) = arcObj.StartPoint(0) - Cos(ang1) * 20
pnt(1) = arcObj.StartPoint(1) - Sin(ang1) * 20
pnt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.StartPoint, pnt)
pnt(0) = arcObj.EndPoint(0) - Cos(ang2) * 20
pnt(1) = arcObj.EndPoint(1) - Sin(ang2) * 20
pnt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.EndPoint, pnt)

'Fascia inferiore
ang1 = AngRif2 - tmp1
ang2 = AngRif2 + tmp1
Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
pnt(0) = arcObj.StartPoint(0) - Cos(ang1) * 20
pnt(1) = arcObj.StartPoint(1) - Sin(ang1) * 20
pnt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.StartPoint, pnt)
pnt(0) = arcObj.EndPoint(0) - Cos(ang2) * 20
pnt(1) = arcObj.EndPoint(1) - Sin(ang2) * 20
pnt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.EndPoint, pnt)

For c = 1 To (nPassi / 2)
   tmp1 = (Fascia / 2 + (c * Tacca) + ((c - 1) * Passo)) / (cirObj.Circumference / (2 * Pg))
   ang1 = AngRif1 + tmp1
   tmp2 = (Fascia / 2 + (c * Tacca) + (c * Passo)) / (cirObj.Circumference / (2 * Pg))
   ang2 = AngRif1 + tmp2
   Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
   pnt(0) = arcObj.StartPoint(0) - Cos(ang1) * 20
   pnt(1) = arcObj.StartPoint(1) - Sin(ang1) * 20
   pnt(2) = 0
   Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.StartPoint, pnt)
   pnt(0) = arcObj.EndPoint(0) - Cos(ang2) * 20
   pnt(1) = arcObj.EndPoint(1) - Sin(ang2) * 20
   pnt(2) = 0
   Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.EndPoint, pnt)
   'Altra parte
   ang1 = AngRif1 - tmp2
   ang2 = AngRif1 - tmp1
   Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
   pnt(0) = arcObj.StartPoint(0) - Cos(ang1) * 20
   pnt(1) = arcObj.StartPoint(1) - Sin(ang1) * 20
   pnt(2) = 0
   Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.StartPoint, pnt)
   pnt(0) = arcObj.EndPoint(0) - Cos(ang2) * 20
   pnt(1) = arcObj.EndPoint(1) - Sin(ang2) * 20
   pnt(2) = 0
   Set lineObj = ThisDrawing.ModelSpace.AddLine(arcObj.EndPoint, pnt)
Next c


End

End Sub

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  Alberto_Broggian > 12-16-2024, 01:38 PM

  grazie ma credo aspetterò la conversione per nanocad

• RE: MACRO PER MODIFICA CERCHI O ELISSI

  tracciatura.net > 12-16-2024, 11:50 PM

  questa codice è per nanoCAD
  salvalo in .vbs
  imposta le variabili come detto in precedenza
  seleziona il cerchio e vedi il risultato
  
  

  Codice:

  'Costanti di AutoCAD
Const acByBlock = 0 'ByBlock
Const acRed = 1 'Red
Const acYellow = 2 'Yellow
Const acGreen = 3 'Green
Const acCyan = 4 'Cyan
Const acBlue = 5 'Blue
Const acMagenta = 6 'Magenta
Const acWhite = 7 'White or Black, by background color
Const acByLayer = 256 'ByLayer
Const Pg = 3.14159265358

Dim EntObj 'As AcadEntity
Dim AsseCalOrizzontale 'As Boolean
Dim cirObj 'As AcadCircle
Dim lineObj 'As AcadObject
Dim arcObj 'As AcadArc
Dim Fascia, Passo, Tacca, Taglio
Dim nPassi
Dim ang1, ang2, AngRif1, AngRif2
Dim cenPnt(2) 'As Double
Dim pnt(2) 'As Double
Dim tmp1, tmp2
Dim c
Dim StartPoint, EndPoint

' Create the selection set
Dim ssetObj 'As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET" & Rnd(100) * Time)

' Add objects to a selection set by prompting user to select on the screen
ssetObj.SelectOnScreen

If Not(ssetObj.Count = 1) Then
  ThisDrawing.Utility.Prompt "Attenzione più di un oggetto selezionato"
Else
    Set EntObj = ssetObj(0)
    ThisDrawing.Utility.Prompt EntObj.ObjectName
    If (EntObj.ObjectName = "AcDbCircle") Then
        Set cirObj = EntObj        
        '******************************
        'Impostazioni
        '******************************
        AsseCalOrizzontale = True
        'AsseCalOrizzontale = False
        Fascia = 250    'mm pezzo nella direzione della calandratura
        Passo = 100
        Tacca = 10
        Taglio = 20
        '******************************

        If (AsseCalOrizzontale) Then
           AngRif1 = Pg / 2
           AngRif2 = Pg * 1.5
        Else
           AngRif1 = 0
           AngRif2 = Pg
        End If
    
        'In base alla circonferenza arrotondo il passo
        ThisDrawing.Utility.Prompt "Circumference->" & cirObj.Circumference
        ThisDrawing.Utility.Prompt "Passo->" & Passo
        tmp1 = (cirObj.Circumference - 2 * (Fascia + Tacca)) / (Passo + Tacca)
        nPassi = Int(tmp1 / 2) * 2
        Passo = (cirObj.Circumference - 2 * (Fascia + Tacca)) / nPassi - Tacca
        ThisDrawing.Utility.Prompt "NuovoPasso->" & Passo

        cirObj.color = acMagenta
        'Fascia superiore
        tmp1 = (Fascia / 2) / (cirObj.Circumference / (2 * Pg))
        ang1 = AngRif1 - tmp1
        ang2 = AngRif1 + tmp1
        Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
        StartPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.StartPoint)
        pnt(0) = StartPoint(0) - Cos(ang1) * 20
        pnt(1) = StartPoint(1) - Sin(ang1) * 20
        pnt(2) = 0
        Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, pnt)
        EndPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.EndPoint)
        pnt(0) = EndPoint(0) - Cos(ang2) * 20
        pnt(1) = EndPoint(1) - Sin(ang2) * 20
        pnt(2) = 0
        Set lineObj = ThisDrawing.ModelSpace.AddLine(EndPoint, pnt)
    
        'Fascia inferiore
        ang1 = AngRif2 - tmp1
        ang2 = AngRif2 + tmp1
        Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
        StartPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.StartPoint)
        pnt(0) = StartPoint(0) - Cos(ang1) * 20
        pnt(1) = StartPoint(1) - Sin(ang1) * 20
        pnt(2) = 0
        Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, pnt)
        EndPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.EndPoint)
        pnt(0) = EndPoint(0) - Cos(ang2) * 20
        pnt(1) = EndPoint(1) - Sin(ang2) * 20
        pnt(2) = 0
        Set lineObj = ThisDrawing.ModelSpace.AddLine(EndPoint, pnt)

        For c = 1 To (nPassi / 2)
            tmp1 = (Fascia / 2 + (c * Tacca) + ((c - 1) * Passo)) / (cirObj.Circumference / (2 * Pg))
            ang1 = AngRif1 + tmp1
            tmp2 = (Fascia / 2 + (c * Tacca) + (c * Passo)) / (cirObj.Circumference / (2 * Pg))
            ang2 = AngRif1 + tmp2
            Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
            StartPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.StartPoint)
            pnt(0) = StartPoint(0) - Cos(ang1) * 20
            pnt(1) = StartPoint(1) - Sin(ang1) * 20
            pnt(2) = 0
            Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, pnt)
            EndPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.EndPoint)
            pnt(0) = EndPoint(0) - Cos(ang2) * 20
            pnt(1) = EndPoint(1) - Sin(ang2) * 20
            pnt(2) = 0
            Set lineObj = ThisDrawing.ModelSpace.AddLine(EndPoint, pnt)
            'Altra parte
            ang1 = AngRif1 - tmp2
            ang2 = AngRif1 - tmp1
            Set arcObj = ThisDrawing.ModelSpace.AddArc(cirObj.Center, cirObj.Radius, ang1, ang2)
            StartPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.StartPoint)
            pnt(0) = StartPoint(0) - Cos(ang1) * 20
            pnt(1) = StartPoint(1) - Sin(ang1) * 20
            pnt(2) = 0
            Set lineObj = ThisDrawing.ModelSpace.AddLine(StartPoint, pnt)
            EndPoint = ThisDrawing.Utility.CreateSafeArrayFromVector(arcObj.EndPoint)
            pnt(0) = EndPoint(0) - Cos(ang2) * 20
            pnt(1) = EndPoint(1) - Sin(ang2) * 20
            pnt(2) = 0
            Set lineObj = ThisDrawing.ModelSpace.AddLine(EndPoint, pnt)
        Next
    Else
        ThisDrawing.Utility.Prompt "Non è un cerchio"
    End If
End If
• Precedente Successivo