Soyez le premier à donner votre avis sur cette source.
Snippet vu 18 508 fois - Téléchargée 34 fois
Option Explicit Const RayonHydrogene = 1.2 Const RayonAzote = 1.54 Const RayonCarbone = 1.85 Const Echelle = 8.405 Dim Docs1 As Documents Dim PartMolecule As Document Sub CATMain() Dim objParcourir As Object Dim CARFileName As String Dim objectFSO 'As New FileSystemObject Dim Fichier 'As TextStream Dim strLine, NomCorps As String Dim x, y, z, rayon As Double Dim line, intResult, Rouge, Vert, Bleu As Integer Dim Point, Sphere As Object Dim myHybridBody, referencebody As Object Dim parameters1 As Parameters Dim strParam1 As StrParam Dim EnsembleCorps As Bodies Dim CorpsDePiece As Body Dim reference1, reference2 As Reference Dim closeSurface1 As CloseSurface Dim ObjSelection As Selection ' On crée et on affiche une boite de dialogue Parcourir en ' filtrant le type de fichier affichés Set objParcourir = CreateObject("UserAccounts.CommonDialog") objParcourir.Filter = "car File|*.car|All Files|*.*" 'objParcourir.Flags = &H0200 objParcourir.FilterIndex = 1 objParcourir.InitialDir = "C:\" intResult = objParcourir.ShowOpen ' Si on n'a pas choisi de fichier le programme s'arrete. If intResult = 0 Then Exit Sub End If ' On ouvre le fichier choisi CARFileName = objParcourir.FileName Set objectFSO = CreateObject("Scripting.FileSystemObject") Set Fichier = objectFSO.OpenTextFile(CARFileName, 1, True) ' On crée un nouveau fichier Part et on le renomme. Set Docs1 = CATIA.Documents Set PartMolecule = Docs1.add("Part") PartMolecule.Product.PartNumber = "Molecule" ' On veut cacher les trois plans de référence Set ObjSelection = PartMolecule.Selection ' On récupère la sélection courante dans notre pièce ObjSelection.Clear ObjSelection.add PartMolecule.Part.OriginElements.PlaneXY ObjSelection.add PartMolecule.Part.OriginElements.PlaneYZ ObjSelection.add PartMolecule.Part.OriginElements.PlaneZX ObjSelection.VisProperties.SetShow catVisPropertyNoShowAttr ' On commencera par créer des sphères en surfacique pour ensuite ' les transformer en volumique. ' Les corps surfaciques sont des HybridBody. Set myHybridBody = PartMolecule.Part.HybridBodies.add() myHybridBody.Name = "GeometryMol" ' EnsembleCorps contient l'ensemble des Corps de Pièce de notre Part. Set EnsembleCorps = PartMolecule.Part.Bodies Set reference1 = PartMolecule.Part.CreateReferenceFromName("") ' Boucle qui va extraire les informations utile du fichier et créer les atomes dans CATIA. line = 1 While Not Fichier.AtEndOfStream strLine = Fichier.ReadLine ' On s'assure que la ligne n'est ni vide ni en commentaire (le !) If ((Len(strLine) > 0) And (Not (Left(strLine, 1) = "!"))) Then ' On vérifie que la ligne contient bien un nombre en 2eme colonne If IsNumeric(Mid(strLine, 2, 5)) Then 'Récupération des infos x = Val(Mid(strLine, 9)) * Echelle y = Val(Mid(strLine, 24)) * Echelle z = Val(Mid(strLine, 39)) * Echelle NomCorps = Left(strLine, 5) Select Case (Mid(strLine, 72, 1)) Case "C" rayon = RayonCarbone * Echelle Rouge = 0 Vert = 0 Bleu = 255 Case "H" rayon = RayonHydrogene * Echelle Rouge = 255 Vert = 255 Bleu = 255 Case "N" rayon = RayonAzote * Echelle Rouge = 0 Vert = 255 Bleu = 0 End Select 'On ajoute un nouveau corps de pièce pour l'atome en cours. Set CorpsDePiece = EnsembleCorps.add() CorpsDePiece.Name = NomCorps 'On créé un point à la position indiquée dans le fichier, puis on ' s'en sert pour ajouter une sphère au bon rayon. Set Point = PartMolecule.Part.HybridShapeFactory.AddNewPointCoord(x, y, z) Set Sphere = PartMolecule.Part.HybridShapeFactory.AddNewSphere(Point, Nothing, rayon, -90, 90, 0, 360) 'myHybridBody.AppendHybridShape Sphere 'Permet d'ajouter l'objet créé dans le HybridBody ' Transformation en corps volumique Set closeSurface1 = PartMolecule.Part.ShapeFactory.AddNewCloseSurface(reference1) Set reference2 = PartMolecule.Part.CreateReferenceFromObject(Sphere) closeSurface1.Surface = reference2 ' Technique pour changer la couleur d'un élément. Set ObjSelection = PartMolecule.Selection ObjSelection.Clear ObjSelection.add CorpsDePiece ObjSelection.VisProperties.SetRealColor Rouge, Vert, Bleu, 1 'PartMolecule.Part.Update line = line + 1 End If End If Wend PartMolecule.Part.Update End Sub ' Exemple d'un fichier *.CAR : molécule de toluène ' Pensez a enlever l'apostrophe en début de ligne. '!BIOSYM archive 3 'PBC=OFF '!DATE Wed Jun 28 11:20:26 2006 'C1 -0.000587572 -0.305649638 0.010987936 XXX ND C_R C 0.000 'C2 -0.682412148 0.921967447 0.060582917 XXX ND C_R C 0.000 'H1 -0.134903491 1.855818629 0.090066366 XXX ND H_ H 0.000 'C3 -2.080808878 0.949411213 0.072386093 XXX ND C_R C 0.000 'H2 -2.602594376 1.896936655 0.110630915 XXX ND H_ H 0.000 'C4 -2.805644512 -0.245127603 0.034861680 XXX ND C_R C 0.000 'H3 -3.887702942 -0.221981764 0.044063833 XXX ND H_ H 0.000 'C5 -2.133326769 -1.469513297 -0.014543146 XXX ND C_R C 0.000 'H4 -2.695469618 -2.393985987 -0.043574754 XXX ND H_ H 0.000 'C6 -0.735176623 -1.501351118 -0.026503135 XXX ND C_R C 0.000 'H5 -0.224755973 -2.455921650 -0.064914539 XXX ND H_ H 0.000 'C7 1.498682141 -0.352547675 -0.002297481 XXX ND C_3 C 0.000 'H6 1.938825011 0.666825652 0.031103747 XXX ND H_ H 0.000 'H7 1.861794949 -0.921559393 0.879336536 XXX ND H_ H 0.000 'H8 1.847819567 -0.856299460 -0.928170502 XXX ND H_ H 0.000 'end 'end
9 janv. 2012 à 14:00
Pour se ou sa ne marche pas: le copier coller ne mais que 1 espace entre chaque mots => -0.1 0.1 deviens : -0.1 0.1
27 avril 2007 à 02:59
Mais cela ne règle pas mon problème précédent avec le catcript (cela aurait trop facile)?
A+
27 avril 2007 à 01:03
Sympa ce prog , bon par contre j'ai un petit pb avec ! sur V5R11
Il me créer un fichier vide en cachant les plans et en créant une nom surfacique GeometryMol vide aussi? (rien n'est caché)
J'ai jete un oeil rapide au script , je sais pas si c'est un pb sur le script ou le fichier .car
Pourrais tu mettre les fichiers en zip en ligne stp pour voir si j'ai pas foire mon ctrl+c/V.
Ha oui au passage j'ai un pb avec un autre script de type VBA fichier TinyPDM4CATIA-0-25.catvba de l'url http://cao.etudes.ecp.fr/index.php?page=tiny_psr.htm impossible de le chargé il n'est pas visible pour le menu macro !
Je me pose donc une question faut il un module special pour le VBA sous cat ??
Il est sympa ce script !
Merci pour votre aide.
A+
6 avril 2007 à 12:02
Juste pour information, jean_marc_n2, la version complete de CATIA V5 ne coute "que" 150.000 euros environ (1 million de francs).
1 mars 2007 à 16:44
http://www.cadxp.com/forumXForum-41.htm
http://cao.etudes.ecp.fr/index.php?page=faq.htm#9
http://www.coe.org/Collaboration/DiscussionForum/ActiveDiscussions/tabid/210/Default.aspx
http://www4.utc.fr/~tn13/index.php?op=liens
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.