Aller au contenu
Problème de lien d'inscription (résolu ?) ×

VBA : Utilisation de ConstructFillet

Invité TBFT

Par Invité TBFT
dans Microstation

 Partager

Messages recommandés

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Bonjour

 

J'essaye d'utiliser la fonction ConstructFillet.

Les arrondis obtenues sont mal placé.

 

Voici la partie de la macro qui est sensé créer un arrondi entre deux segments:

' mise en place des coubes

Set el_tp10 = Droite(1).G_Line

Set el_tp20 = Droite(4).G_Line

Set courbe(1) = el_tp10.ConstructFillet(el_tp20, Nothing, rayon_mini, el_tp10.EndPoint, Rotation)

Set courbe(2) = el_tp10.ConstructFillet(el_tp20, Nothing, rayon_mini, el_tp10.StartPoint, Rotation)

Set courbe(3) = el_tp20.ConstructFillet(el_tp10, Nothing, rayon_mini, el_tp20.StartPoint, Rotation)

Set courbe(4) = el_tp20.ConstructFillet(el_tp10, Nothing, rayon_mini, el_tp20.EndPoint, Rotation)

'selection de la bonne courbe

ActiveModelReference.AddElement courbe(1)

ActiveModelReference.AddElement courbe(2)

ActiveModelReference.AddElement courbe(3)

ActiveModelReference.AddElement courbe(4)

 

D'avance merci

 

A+

 

TBFT

lrdb@home Rookie

lrdb@home

Posté(e)
Posté(e)

Bonjour,

je ne comprends pas tout, en sélectionnant 2 lignes liGn (0) et liGn(1) dans un dessin,

ceci fonctionne et suffit.

 

 

Set Arcele = liGn(0).ConstructFillet(liGn(1), Nothing, 10, liGn(0).StartPoint, ActiveDesignFile.Views(1).Rotation)
ActiveModelReference.AddElement Arcele

 

Reflexion faite, ton problème est de trouver le bon point "pickpoint" dans l'aide?

2 droites qui se croisent= 4 possibilités de placement d'arc

c'est bien çà?

 

 

 

Dim ptPick(1 To 4) As Point3d
ptPick(1) = Point3dInterpolate(liGn(0).StartPoint, 0.5, liGn(1).StartPoint)
ptPick(2) = Point3dInterpolate(liGn(1).StartPoint, 0.5, liGn(0).EndPoint)
ptPick(3) = Point3dInterpolate(liGn(0).EndPoint, 0.5, liGn(1).EndPoint)
ptPick(4) = Point3dInterpolate(liGn(1).EndPoint, 0.5, liGn(0).StartPoint)

Set Arcele = liGn(0).ConstructFillet(liGn(1), Nothing, 10, ptPick(1), ActiveDesignFile.Views(1).Rotation)
ActiveModelReference.AddElement Arcele
Set Arcele = liGn(0).ConstructFillet(liGn(1), Nothing, 10, ptPick(2), ActiveDesignFile.Views(1).Rotation)
ActiveModelReference.AddElement Arcele
Set Arcele = liGn(0).ConstructFillet(liGn(1), Nothing, 10, ptPick(3), ActiveDesignFile.Views(1).Rotation)
ActiveModelReference.AddElement Arcele
Set Arcele = liGn(0).ConstructFillet(liGn(1), Nothing, 10, ptPick(4), ActiveDesignFile.Views(1).Rotation)
ActiveModelReference.AddElement Arcele

 

dans ce cas, les 4 arcs sont dessinés.

Cordialement

LrDb

 

[Edité le 23/3/2011 par lrdb@home]

write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Bonjour LrDB

 

Merci pour l'aide.

J'essaye et refait un message avec ce j'ai pu obtenir.

 

A+

 

TBFT

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Re Bonjour

 

Je viens de faire des essayer j'otiens bien 4 arcs....

Mais deux arcs sont placés au même endroit.

Et il me manque toujours celui qui m'interresse..

J'ai essayé de mettre un rayon ridiculement petit. pareil. :exclam:

 

A+

 

TBFT

 

[Edité le 24/3/2011 par TBFT]

LrDb Newbie

LrDb

Posté(e)
Posté(e)

Bonjour ,

Bizarre, as tu bien recopier les ptpick ?

c'est hyper important.

pour vérifier, copie ceci

 Dim liGverif As LineElement
Set liGverif = CreateLineElement2(Nothing, ptPick(1), ptPick(2))
ActiveModelReference.AddElement liGverif
liGverif.Redraw
MsgBox "ligne1"
Set liGverif = CreateLineElement2(Nothing, ptPick(2), ptPick(3))
ActiveModelReference.AddElement liGverif
liGverif.Redraw
MsgBox "ligne2"
Set liGverif = CreateLineElement2(Nothing, ptPick(3), ptPick(4))
ActiveModelReference.AddElement liGverif
liGverif.Redraw
MsgBox "ligne3"
Set liGverif = CreateLineElement2(Nothing, ptPick(4), ptPick(1))
ActiveModelReference.AddElement liGverif
liGverif.Redraw
MsgBox "ligne4"

les lignes doivent se dessiner à la suite, dans le sens trigo ou l'inverse mais à la suite

 

LrDb

Write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Re,

 

J'ai oublié de preciser un truc... Manque d'habitude...

 

Lorsque j'écris ceci :

' mise en place des coubes

Set el_tp10 = Droite(1).G_Line

Set el_tp20 = Droite(4).G_Line

 

Le début de droite 4 croorespond exactement à la fin de la droite 1.

C'est comme ça que je l'ai créer....

 

A+

 

TBFT

LrDb Newbie

LrDb

Posté(e)
Posté(e)

Re,

Mouais, donc, ton ptpick doit être

le point milieu entre fin droite 4 et début droite 1

si j'ai bien compris.

mais pour quoi dessiner 4 arcs?

et que cherches-tu à faire réellement?

(autant partir sur de bonne base)

Cordialement

LrDb

 

 

Write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Re,

 

Merci beaucoup pour ton assistance.

Serais t'il possible de poster ou de t'envoyer un fichier exemple,stp?

 

A+

 

TBFT

LrDb Newbie

LrDb

Posté(e)
Posté(e)

Cliques sur "Recherche CADxp" fais une recherche de membre "lrdb"

tu dois pouvoir envoyer un message privé.

PS: je suis au travail, pas "@home"

Merci

pour les pièces jointes utilise ci-joint.com ou qqch comme ça

LrDb

 

 

Write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Re

 

Je viens de poster le fichier sur le site de ci-joint :

http://www.cijoint.fr/cjlink.php?file=cj201103/cijAM4hfjL.zip

 

Le fichier fichier zip contient trois fichiers.

- le dgn qui contient l'exemple.

- le fichier bas qui contient les macros

- le fichier cls qui contient un module de class pour la gestion de mon traçage de trait.

 

Apparement le module de classe fonctionne bien.... pas le reste....

Pour lancer la macro, il est nécessaire de selectionner deux traits...

 

Je paris que l'erreur est doit être énorme.....

 

Merci d'avance et A+

 

TBFT

LrDb Newbie

LrDb

Posté(e)
Posté(e)

A première vu, emmelage de pinceaux.

 

Set el_Tp10 = Droite(1).G_Line

Set el_Tp20 = Droite(4).G_Line

c'est là que cela merdoies tu devrais écrire dans ton module principal tes lignes.

pas la peine de passer par module de class à cet endroit.

Property Get G_Line() As LineElement

Set G_Line = el_line; ici c'est la dernière dessinée

End Property

 

On obtiens pas la même chose en dessinant toutes les lignes

Pourrais-tu envoyer de la même façon un dgn fini

de ce que tu souhaites avec un p'tit txt d'explication par exemple.

 

Une chose aussi très importante, l'ordre de selection de tes 2 droites au départ. qui détermine

les droites 1 et 4 en haut ou en bas.

 

LrDb

[Edité le 24/3/2011 par LrDb]

 

[Edité le 25/3/2011 par LrDb]

Write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Bonjour

 

Merci pour aide précieuse, dés que je peux, je te fais passer un dgn avec le "bon" arc..

 

A+

 

TBFT

LrDb Newbie

LrDb

Posté(e)
Posté(e)

Bonjour TBFT,

'traçage des segments primaires

Droite(1).trace

Set el_Tp10 = Droite(1).G_Line

Droite(4).trace

Set el_Tp20 = Droite(4).G_Line

'tu récupéres ici tes 2 droites juste après les avoir dessinées

.....

'mise en place des coubes

Dim ptPick As Point3d 'fameux ptpick

ptPick = Point3dInterpolate(el_Tp10.StartPoint, 0.5, el_Tp20.EndPoint)

'point milieu des 2 extrémités opposées (super fonction)

Set Courbe(1) = el_Tp20.ConstructFillet(el_Tp10, Nothing, rayon_mini, ptPick, Rotation)

ActiveModelReference.AddElement Courbe(1)

Courbe(1).Redraw'pour la forme

et voilà.

Comme je te l'ai dis, l'ordre de sélection des 2 droites est hyper important

edit:

la matrice n'est pas bonne, ce doit-être ça

il faut faire un rotation de vue par 3 points

1 extrémité droite4,point commun,+extrémité droite1

Matrix3d = object.Matrix3dRotationFromPoint3dOriginXY (Origin, XPoint, YPoint)

et ensuite utiliser la rotation de views(1).rotation,

pas matrx3Dzero.

je viens seulement de m'apercevoir que c'était de la 3D :exclam:

 

LrDb[Edité le 25/3/2011 par LrDb][Edité le 25/3/2011 par LrDb]

 

[Edité le 25/3/2011 par LrDb]

Write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Bonjour

 

Je suis pas sure d'avoir tout bien compris.

Mais je te promet de mettre mon portable en route et de faire tout ce que je peux pour comprendre ce que tu m'explique.

Je reviendrai ensuite....

 

Merci encore une fois....

 

A+ et bon week end....

 

TBFT

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Re bonjour

 

Je viens de faire des essaies mais je bloque sur

 

Matrix3d = object.Matrix3dRotationFromPoint3dOriginXY (Origin, XPoint, YPoint)

 

Je n'arrive pas à trouver quoi mettre à la place d'object....

J'ai essayé en autre avec application.... mais marche pas...

 

A+

 

TBFT

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Re

 

Je viens de voir (par hasard) pourquoi cela ne marche pas chez moi

J''ai alors écris

 

Rotation= Matrix3dRotationFromPoint3dOriginXY (ptPick, el_Tp10.StartPoint, el_Tp20.EndPoint)

 

Ca marche sauf dans un cas.... je te transmet le fichier cet après midi..

 

A+

 

TBFT

lrdb@home Rookie

lrdb@home

Posté(e)
Posté(e)

Bonjour,

j'ai moi aussi qq problème avec cette fonction.

fais une recherche sur google, sur le site de Bentley...,On n'est pas les seuls

ou inscris-toi il y a je pense des têtes qui pourront te répondre (suis autodidacte).

ceci dit, j'ai abandonné cette fonction pour feinter en utilisant le placement d'arc tangent à tes 2 droites (un peu à la dégonfle).

 

 

   'calcul des nouveaux coordonnées
 Droite(1).init Vecteur(1).P_Start, Calcul_Point_Prolonger(Vecteur, False)
 Droite(2).init Vecteur(2).P_Start, Calcul_Point_Prolonger(Vecteur, True)
 Droite(1).Coupe_Quart
 Droite(2).Coupe_Quart
 Droite(3).init Droite(1).P_Stop, Droite(2).P_Stop
 Droite(3).Coupe_Moitier_Millieu
 Droite(1).Coupe_Moitier
 Droite(2).Coupe_Moitier
 Droite(4).init Droite(1).P_Stop, Droite(3).P_Stop
 Droite(5).init Droite(3).P_Start, Droite(2).P_Stop
 
 'traçage des segments primaires
 Droite(1).trace
   Set el_Tp10 = Droite(1).G_Line
 Droite(4).trace
   Set el_Tp20 = Droite(4).G_Line
   Dim liGverif As LineElement
 'calcul du rayon mini
 rayon_mini = Droite(1).Longueur
 rayon = Droite(3).Longueur
 If rayon < rayon_mini Then rayon_mini = rayon
 rayon = Droite(4).Longueur / 2
 If rayon < rayon_mini Then rayon_mini = rayon
 
 rayon_mini = rayon_mini / 2
 'MessageCenter.AddMessage "Le rayon maxi est de " + CStr(rayon_mini) + " m"
 MsgBox "Le rayon maxi est de " + CStr(rayon_mini) + " m"
 
 'mise en place des coubes
Dim ptPick As Point3d
ptPick = Point3dInterpolate(el_Tp10.startPoint, 0.5, el_Tp20.EndPoint)
CadInputQueue.SendKeyin "choose none"

   CadInputQueue.SendKeyin "lock snap tangency" 'accrochage tangent
   CadInputQueue.SendKeyin "PLACE ARC ICON "
   SetCExpressionValue "tcb->msToolSettings.igen.placeArcMode", 1, "IGEN" 'placement arc par contour
   CadInputQueue.SendCommand "IGEN CONSTRAIN RADIUS LOCK "
   CadInputQueue.SendCommand "IGEN CONSTRAIN RADIUS " & rayon_mini 'rayon !!Attention!!,mettre le séparateur décimal . et non , dans les options régionnales
   CadInputQueue.SendTentativePoint Point3dInterpolate(el_Tp10.startPoint, 0.5, el_Tp10.EndPoint), 1
   CadInputQueue.SendDataPoint ptPick, 1
   CadInputQueue.SendTentativePoint Point3dInterpolate(el_Tp20.startPoint, 0.5, el_Tp20.EndPoint), 1
   CadInputQueue.SendDataPoint ptPick, 1
   CadInputQueue.SendReset

Bon, tiens nous au courant.

Cordialement

LrDb

 

[Edité le 27/3/2011 par lrdb@home]

write a book about what ??

LrDb Newbie

LrDb

Posté(e)
Posté(e)

Bonjour TBFT

avec la rotation de vue par trois points:

   'traçage des segments primaires
 Droite(1).trace
   Set el_Tp10 = Droite(1).G_Line
 Droite(4).trace
   Set el_Tp20 = Droite(4).G_Line

 'parametrage de la rotation de vue
 
   CadInputQueue.SendCommand "ROTATE VIEW EXTENDED "
   SetCExpressionValue "dialogInfo.p.rotationMode", 3, "VIEWCTRL"
       CadInputQueue.SendCommand "ROTATE VIEW EXTENDED "
   SetCExpressionValue "dialogInfo.p.rotationMode", 3, "VIEWCTRL"
       CadInputQueue.SendTentativePoint el_Tp10.startPoint, 1
   CadInputQueue.SendDataPoint el_Tp10.startPoint, 1
           CadInputQueue.SendTentativePoint el_Tp10.EndPoint, 1
   CadInputQueue.SendDataPoint el_Tp10.EndPoint, 1
           CadInputQueue.SendTentativePoint el_Tp20.EndPoint, 1
   CadInputQueue.SendDataPoint el_Tp20.EndPoint, 1
   CadInputQueue.SendDataPoint Point3dFromXYZ(0, 0, 0), 1
       CadInputQueue.SendReset
 RRotation = ActiveDesignFile.Views(1).Rotation
 'Rotation = Matrix3dZero
 
 'calcul du rayon mini
 rayon_mini = Droite(1).Longueur
 rayon = Droite(3).Longueur
 If rayon < rayon_mini Then rayon_mini = rayon
 rayon = Droite(4).Longueur / 2
 If rayon < rayon_mini Then rayon_mini = rayon
 
'  rayon_mini = rayon_mini / 2
 MessageCenter.AddMessage "Le rayon maxi est de " + CStr(rayon_mini) + " m"
 'MsgBox "Le rayon maxi est de " + CStr(rayon_mini) + " m"
 
 'mise en place des coubes
Dim ptPick As Point3d
ptPick = Point3dInterpolate(el_Tp10.startPoint, 0.5, el_Tp20.EndPoint)
 Set Courbe(1) = el_Tp20.ConstructFillet(el_Tp10, Nothing, rayon_mini, ptPick, RRotation)
 ActiveModelReference.AddElement Courbe(1)
 Courbe(1).Redraw
   CadInputQueue.SendKeyin "view previous"
   CadInputQueue.SendKeyin "xy="

Write a book about what ??

Invité TBFT

Invité TBFT

Posté(e)
Posté(e)

Bonjour

 

Je regarde dés que je peux....

 

Dis moi, par hasard, sais tu comment tracer une B-spline en vba ?

Cela pourrais être une solution à mon problème!!

 

Quand pense tu?

 

A+

 

TBFT

LrDb Newbie

LrDb

Posté(e)
Posté(e)

Tu peux enregistrer une macro comme sur excel

regardes ici

Ce site appartient à l'un des intervenants programmation de bentley souvent présent et réactif dans le forum vba de bentley.

pour la smartline,

Cliques sur l'outils smartline dans la palette principale, type de sommet arrondi et entre ton rayon...

ces valeurs sont enregistrées dans la macro en général (pas pour toutes les fonctions).

LrDb

 

Write a book about what ??

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité