Bloc+attribut --> Espace_ADT

mikl63 · le 2 mai 2011

à part recréer des blocs des différents éléments, je ne vois pas.

Tu isoles chaque calque que tu souhaite garder en bloc puis commande bloc...

lili2006 · le 2 mai 2011

Re,

Merci pour vos réponses,

Christian du fond du bois, le blaireau se découvre enfin...

A priori, ça ne change pas grand chose pour certain d'entre nous,.... ;)

PS: n'hesitez pas a POLLUER mon sujet avec vos discussions

Ok ! :D

rebcao · le 2 mai 2011

ReRe,

A priori, ça ne change pas grand chose pour certain d'entre nous,....

AH ben chi, il signe plus en codé... ;)

Chris... et le reste...

didier · le 2 mai 2011

coucou

on peut répondre ici ?

j'avais répondu, avec une pointe d'ironie,

au message de Lili2006 qui faisait de la pub pour son forum

et je suis dépité de ne pas voir ma prose dans les réponses

dès que j'ai Jean-Paul II au téléphone, je le bascule chez Cadmin...

amicalement

rebcao · le 2 mai 2011

Hé hé,

PS: n'hesitez pas a POLLUER mon sujet avec vos discussions

Alors là on ne va pas se gêner. ;)

http://www.rebcao.fr/cadxp/conneries/pollution.jpg et voilà ce qui arrive http://www.rebcao.fr/cadxp/conneries/Crabe_sur-le-dos.jpg

Le Crabe va monter ses pinces http://www.rebcao.fr/cadxp/conneries/Touloulou_agressif2.jpg

C'est bien lui... http://www.rebcao.fr/cadxp/conneries/LeBlaireau_frimousse2.jpg

[Edité le 2/5/2011 par rebcao]

FormaBois · le 2 mai 2011

Salut,

voir les variables FRAME et IMAGEFRAME

FormaBois · le 2 mai 2011

Salut,

voir les variables FRAME et IMAGEFRAME

lili2006 · le 2 mai 2011

Re,

Il fait déjà très très chaud en Alsace,... :D

j'avais répondu, avec une pointe d'ironie,
au message de Lili2006 qui faisait de la pub pour son forum

Et alors ? Ou est le problème ?,

De plus, tu as du mal lire mon cher Didier,... ;)

http://db.tt/MyzEWRW

bryce · le 2 mai 2011

Bonjour,

Il suffit de remplacer l'échelle d'insertion du bloc, qui est de 1 dans ta macro.

^C^C-inserer SYM_28_poutrelle;\0.1;0.1;0;chprop;d;;ca;x_______28;;

gloups · le 2 mai 2011

Si tu est sur version complete, utilises l'outil Flatten des express tools et le problème sera réglé.

Si tu est sur une version LT il existe aussi des solutions dont une macro diesel écrit par rebcao et que trouveras sur le top quiz des galères autocad. (enfin pour la version lt, je dis tout ça de mémoire :casstet: )

La Lozère · le 2 mai 2011

BONJOUR,

Essais la commande "cadreimage". Sur une version pleine d'Autocad, cela gère l'affichage du cadre des image raster.

Maintenant, je sais pas si cela fonctionne sur une version LT....

Sinon, ouvre ton fichier avec une version pleine (si possible), active le cadre, ferme ton fichier en l'enregistrant et ré-ouvre ton fichier sur ta version LT. A tester....

A PLUS.

Steven · le 2 mai 2011

C'est l'histoire d'un mec sur le pont de l'Alma.

lili2006 · le 3 mai 2011

Re,

C'est l'histoire d'un mec sur le pont de l'Alma.

Elle est bonne heinnnnnnnnnnn :D

mikl63 · le 3 mai 2011

Ca plante quand tu ouvres un dwg vierge aussi ?

Si oui, il faudrait que tu recharges ton profil (à condition d'en avoir crée un par avance)

wookichu · le 3 mai 2011

bonjour,

tu peux d'abord faire une selection de tout tes objets et taper la commande :

changer puis propriété puis elevation puis 0.0

là tes objets ""plats"" mais en altitudes se mettront tous à la cote 0,0

si par contre tu as des objets ""inclinés"" (ligne avec point de départ à z= 15m et z d'arrivée à 3m par exemple) tape la commande :

flatten

tu peux même faire un flatten dès le début mais moi j'aime pas trop l'utiliser...

a+

Marcooo · le 3 mai 2011

Je crois que je suis face à un bug du forum car je ne vois pas l'ensembles des réponses qui ont été faites sur mon post :(

Je ne peux lire que ce que j'ai écrit !!

Alors j'espère que tout ceci va s'arranger sinon, je n'aurai pas la possibilité de lire vos réponses !!!

djn06 · le 3 mai 2011

:casstet: j'ai refait le plan, réinsertion xrefs, etc, ça fait pareil !!

Pinaise ça promet .......##@&$ Tonnerre de Brest !!!

Steven · le 3 mai 2011

Re,

C'est l'histoire d'un mec sur le pont de l'Alma.

Elle est bonne heinnnnnnnnnnn :D

Elle est rigolote :D

bexkivr · le 3 mai 2011

Bonjour,

Tranforme ton arc en polyligne, puis donne l'épaisseur que tu veux.

wookichu · le 3 mai 2011

bonjour,

le plus simple est de transformer ton arc en polyligne avec la commande PEDIT, puis de lui donner une largeur...

a+

wookichu · le 3 mai 2011

ou alors tu fait: epaissligne puis tu choisit l'épaisseur.

mais attention il faut que la variable LWDISPLAY soit active pour que tu le voie à l'écran...

Dinosor · le 3 mai 2011

Hello,

Faut le transformer en polyligne au préalable. ;)

bazoul · le 3 mai 2011

Salut l'ami.

Je te propose cette classe.Bon je te l'accorde ya un peu de ménage a faire dans le code ( genre des commentaires inutiles et des commentaires utile qui sont absent! )

Maintenant,si tu as aucune notion dans le langage ce code risque d'etre un peu compliqué,analyse un peu ce qu'il fait,et si besoin demande des précisions.

La code est en managé:

''' 
''' Class permettant de créer une polyligne en intégrant les arcs
''' 
''' Source : http://through-the-interface.typepad.com/through_the_interface/2010/12/jigging-an-autocad-polyline-with-arc-segments-using-net.html
Public Class BulgePolyJig
   Inherits EntityJig

#Region "Déclaration interne"

   Private _tempPoint As Point3d = Nothing
   Private _plane As Plane = Nothing
   Private _isArcSeg As Boolean = False
   Private _isUndoing As Boolean = False
   Private _isClosed As Boolean = False
   Private _allowArc As Boolean = False
   Private _RigthClickClose As Boolean = False
   Private _ucs As Matrix3d = Nothing
   Private _MiddlePoint As Point3d = Nothing

#End Region

   Private mLineTypeId As ObjectId = GetLineTypeIdFromLineTypeName("CACHE")

   ''' 
   ''' Constructeur
   ''' 
   ''' SCU dans lequel faire les calculs
   ''' Type de ligne
   Public Sub New(ByVal ucs As Matrix3d, ByVal LineTypeName As String)
       MyBase.New(New Polyline)
       Dim pline As Polyline = Nothing
       Dim normal As Vector3d = Nothing

       Try
           mLineTypeId = GetLineTypeIdFromLineTypeName(LineTypeName)
           _ucs = ucs
           normal = Vector3d.ZAxis.TransformBy(ucs)
           _plane = New Plane(Point3d.Origin, normal)
           pline = TryCast(Me.Entity, Polyline)
           pline.SetDatabaseDefaults()
           pline.Normal = normal
           AddDummyVertex()

       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Constructeur
   ''' 
   ''' Type de ligne
   ''' Le scu utilisé pour les calculs est le scu courant.
   Sub New(Optional ByVal LineTypeName As String = "")
       MyBase.New(New Polyline)
       Dim pline As Polyline = Nothing
       Dim normal As Vector3d = Nothing
       Try
           If LineTypeName.Trim <> "" Then mLineTypeId = GetLineTypeIdFromLineTypeName(LineTypeName)
           _ucs = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.CurrentUserCoordinateSystem
           normal = Vector3d.ZAxis.TransformBy(_ucs)
           _plane = New Plane(Point3d.Origin, normal)
           pline = TryCast(Me.Entity, Polyline)
           pline.SetDatabaseDefaults()
           pline.Normal = normal
           AddDummyVertex()
       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Récupérer l'objetID d'un type de ligne à partir de son nom
   ''' 
   ''' Nom du type de ligne
   ''' ObjectId du type de ligne
   Protected Function GetLineTypeIdFromLineTypeName(ByVal TypeName As String) As ObjectId
       Dim db As Database = Nothing
       Dim tm As DBTransMan = Nothing
       Dim tr As Transaction = Nothing
       Dim bt As LinetypeTable = Nothing
       'gestion de la transaction
       Try
           db = HostApplicationServices.WorkingDatabase
           tm = db.TransactionManager
           tr = tm.StartTransaction
           bt = CType(tm.GetObject(db.LinetypeTableId, OpenMode.ForRead, False), LinetypeTable)

           Return bt.Item(TypeName)
           ''Dim btr As LinetypeTableRecord = CType(tm.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), LinetypeTableRecord)
       Catch
           Return Nothing
       Finally
           If Not tr Is Nothing Then tr.abort() : tr.dispose()
       End Try



   End Function

   Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
       Dim jigOpts As New JigPromptPointOptions()
       Dim pline As Polyline = Nothing
       Dim msgAndKwds As String = ""
       Dim kwds As String = ""
       Dim res As PromptPointResult = Nothing
       Try

           jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NullResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)
           _isUndoing = False
           pline = TryCast(Me.Entity, Polyline)

           If pline.NumberOfVertices = 1 Then

               ' For the first vertex, just ask for the point
               jigOpts.Message = vbLf & "Sélectionner le point de départ :"

           ElseIf pline.NumberOfVertices > 1 Then

               If _isArcSeg Then
                   If _MiddlePoint.X = 0 AndAlso _MiddlePoint.Y = 0 AndAlso _MiddlePoint.Z = 0 Then
                       msgAndKwds = "Sélectionner le point se trouvant sur l'arc ou [undo]: "
                       kwds = "Undo"
                   Else
                       msgAndKwds = "Sélectionner le point d'arrivé de l'arc ou [Line/Undo/Clore]: "
                       kwds = "Line Undo Clore"
                   End If
               Else
                   If _allowArc Then
                       msgAndKwds = vbLf & "Sélectionner le point suivant ou [Arc/Undo/Clore]: "
                       kwds = "Arc Undo Clore"
                   Else
                       msgAndKwds = vbLf & "Sélectionner le point suivant ou [undo/Clore]: "
                       kwds = "Undo Clore"
                   End If
               End If

               jigOpts.SetMessageAndKeywords(msgAndKwds, kwds)
               Else
                   Return SamplerStatus.Cancel
               End If
           ' Should never happen
           ' Get the point itself

           res = prompts.AcquirePoint(jigOpts)
           If res.Status = PromptStatus.Keyword Then

               If res.StringResult.ToUpper() = "ARC" Then
                   _isArcSeg = True
               ElseIf res.StringResult.ToUpper() = "LINE" Then
                   _isArcSeg = False
               ElseIf res.StringResult.ToUpper() = "UNDO" Then
                   _isUndoing = True
                   _isArcSeg = False
               ElseIf res.StringResult.ToUpper() = "CLORE" Then
                   _isClosed = True
               Else
                   MsgBox("Error")
               End If
               Return SamplerStatus.OK

           ElseIf res.Status = PromptStatus.OK Then

               ' Check if it has changed or not (reduces flicker)
               If _tempPoint = res.Value Then
                   Return SamplerStatus.NoChange
               Else
                   _tempPoint = res.Value
                   Return SamplerStatus.OK
               End If
           ElseIf res.Status = PromptStatus.None Then
               If pline.NumberOfVertices <= 1 Then
                   Return SamplerStatus.Cancel
               End If

               If _RigthClickClose Then
                   _isClosed = True
               End If
               Return SamplerStatus.OK
           End If
           Return SamplerStatus.Cancel
       Catch ex As Exception
           Throw ex
       End Try

   End Function

   ''' 
   ''' Fonction de mise a jour du jig
   ''' 
   Protected Overrides Function Update() As Boolean
       Dim pl As Polyline = Nothing
       Dim refDir As Vector3d = Nothing
       Dim lastVertex As Point3d = Nothing, pt As Point3d = Nothing
       Dim arcSegment As CircularArc3d = Nothing
       Dim tangent As Line3d = Nothing
       Dim angle As Double = 0, bulge As Double = 0
       Try
           ' Update the dummy vertex to be our 3D point
           ' projected onto our plane
           pl = TryCast(Me.Entity, Polyline)
           If _isArcSeg Then

               'Si le point du milieu n'est pas défini en mode arc,alors l'utilisateur doit cliquer un point de l'arc
               If _MiddlePoint.X = 0 AndAlso _MiddlePoint.Y = 0 AndAlso _MiddlePoint.Z = 0 Then
                   pl.SetBulgeAt(pl.NumberOfVertices - 2, 0)
               Else

                   'Le point du milieu est défini,alors on dessine l'arc passant par le point du milieu
                   lastVertex = pl.GetPoint3dAt(pl.NumberOfVertices - 2)
                   If pl.NumberOfVertices < 3 Then
                       refDir = New Vector3d(1.0, 1.0, 0.0)
                       pt = pl.GetPoint3dAt(pl.NumberOfVertices - 2)
                       refDir = New Vector3d(_MiddlePoint.X - pt.X, _MiddlePoint.Y - pt.Y, _MiddlePoint.Z - pt.Z)
                   Else
                       ' Check bulge to see if last segment was an arc or a line
                       If pl.GetBulgeAt(pl.NumberOfVertices - 3) <> 0 Then
                           arcSegment = pl.GetArcSegmentAt(pl.NumberOfVertices - 3)
                           tangent = arcSegment.GetTangent(lastVertex)
                           ' Reference direction is the invert of the arc tangent
                           ' at last vertex
                           refDir = tangent.Direction.MultiplyBy(-1.0)
                       Else
                           pt = pl.GetPoint3dAt(pl.NumberOfVertices - 2)
                           refDir = New Vector3d(_MiddlePoint.X - pt.X, _MiddlePoint.Y - pt.Y, _MiddlePoint.Z - pt.Z)
                       End If
                   End If
                   angle = ComputeAngle(_MiddlePoint, _tempPoint, refDir, _ucs)
                   ' Bulge is defined as tan of one fourth of included angle
                   ' Need to double the angle since it represents the included
                   ' angle of the arc
                   ' So formula is: bulge = Tan(angle * 2 * 0.25)
                   bulge = Math.Tan(angle * 0.5)
                   pl.SetBulgeAt(pl.NumberOfVertices - 2, bulge)

               End If
           Else
               'en mode LINE,on remet a vide le point du milieu
               _MiddlePoint = Nothing
               ' Line mode. Need to remove last bulge if there was one
               If pl.NumberOfVertices > 1 Then
                   pl.SetBulgeAt(pl.NumberOfVertices - 2, 0)
               End If
           End If
           pl.SetPointAt(pl.NumberOfVertices - 1, _tempPoint.Convert2d(_plane))
           Return True
       Catch ex As Exception
           Return False
       End Try

   End Function


#Region "Partie Publique"

   ''' 
   ''' Permet de saisir une polyligne dans autocad
   ''' 
   Public Sub Draw()
       Dim ed As Editor = Nothing
       Dim jig As BulgePolyJig = Nothing
       Dim res As PromptResult = Nothing
       Try
           ed = Application.DocumentManager.MdiActiveDocument.Editor
           While True
               res = ed.Drag(Me)
               Select Case res.Status
                   ' New point was added, keep going
                   Case PromptStatus.OK
                       AddDummyVertex()
                       Exit Select
                       ' Keyword was entered
                   Case PromptStatus.Keyword
                       If _isUndoing Then
                           RemoveLastVertex()
                       End If

                       If _isClosed Then
                           ClosePolyline()
                           Exit While
                       End If

                       Exit Select
                       ' If the jig completed successfully, add the polyline
                   Case PromptStatus.None
                       If _isClosed Then
                           ClosePolyline()
                       Else
                           RemoveLastVertex()
                       End If
                       Exit While
                   Case Else
                       ' User cancelled the command, get out of here
                       ' and don't forget to dispose the jigged entity
                       Me.Entity.Dispose()
                       Exit While
               End Select
           End While
       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Ajoute un point nul a la polyligne
   ''' 
   ''' Aucune idée de pourquoi
   Public Sub AddDummyVertex()
       Dim pline As Polyline = Nothing
       Try
           pline = TryCast(Me.Entity, Polyline)
           If _isClosed Then Return
           ' Create a new dummy vertex... can have any initial value

           'On est sur un arc
           If _isArcSeg Then
               'Si le point milieu est vide alors on affecte le dernier point en tant que point milieu
               If _MiddlePoint.X = 0 AndAlso _MiddlePoint.Y = 0 AndAlso _MiddlePoint.Z = 0 Then
                   _MiddlePoint = pline.GetPoint3dAt(pline.NumberOfVertices - 1)
               Else
                   pline.AddVertexAt(pline.NumberOfVertices, New Point2d(0, 0), 0, 0, 0)
                   _isArcSeg = False
               End If
           Else
               pline.AddVertexAt(pline.NumberOfVertices, New Point2d(0, 0), 0, 0, 0)
           End If

       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Supprime le dernier sommet de la polyligne
   ''' 
   Public Sub RemoveLastVertex()
       Dim pline As Polyline = Nothing
       Dim blg As Double = 0

       Try
           pline = TryCast(Me.Entity, Polyline)
           ' Let's first remove our dummy vertex   
           If pline.NumberOfVertices <= 1 Then
               Entity.Dispose()
               Exit Sub
           End If
           ' And then check the type of the last segment
           If pline.NumberOfVertices >= 2 Then
               blg = pline.GetBulgeAt(pline.NumberOfVertices - 2)
               pline.RemoveVertexAt(pline.NumberOfVertices - 1)
               _isArcSeg = (blg <> 0)
           End If


       Catch ex As Exception
           Throw ex
       End Try

   End Sub

   ''' 
   ''' Ferme la polyligne
   ''' 
   ''' Prends en compte si le dernier segment est une ligne ou un arc
   Public Sub ClosePolyline()
       Dim pline As Polyline = Nothing
       Dim blg As Double = 0
       Dim pt As Point3d, lastVertex As Point3d
       Dim refDir As Vector3d
       Dim angle As Double, bulge As Double
       Try

           pline = TryCast(Me.Entity, Polyline)

           If _isArcSeg Then
               lastVertex = pline.GetPoint3dAt(pline.NumberOfVertices - 2)
               ' Check bulge to see if last segment was an arc or a line
               If pline.GetBulgeAt(pline.NumberOfVertices - 3) <> 0 Then
                   refDir = pline.GetArcSegmentAt(pline.NumberOfVertices - 3).GetTangent(lastVertex).Direction.MultiplyBy(-1.0)
               Else
                   pt = pline.GetPoint3dAt(pline.NumberOfVertices - 2)
                   refDir = New Vector3d(_MiddlePoint.X - pt.X, _MiddlePoint.Y - pt.Y, _MiddlePoint.Z - pt.Z)
               End If

               angle = ComputeAngle(_MiddlePoint, pline.GetPoint3dAt(0), refDir, _ucs)
               ' Bulge is defined as tan of one fourth of included angle
               ' Need to double the angle since it represents the included
               ' angle of the arc
               ' So formula is: bulge = Tan(angle * 2 * 0.25)
               bulge = Math.Tan(angle * 0.5)
               pline.SetBulgeAt(pline.NumberOfVertices - 2, bulge)
           End If

           'Le dernier point correspond toujours au point temporaire de la position de la souris
           pline.RemoveVertexAt(pline.NumberOfVertices - 1)
           pline.Closed = True : _isClosed = True

       Catch ex As Exception
           Throw ex
       End Try

   End Sub

   ''' 
   ''' Ajoute la polyligne au ModelSpace
   ''' 
   Public Sub Append()
       Dim bt As BlockTable = Nothing
       Dim btr As BlockTableRecord = Nothing

       Try
           Using tr As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction
               bt = TryCast(tr.GetObject(HostApplicationServices.WorkingDatabase.BlockTableId, OpenMode.ForRead), BlockTable)
               btr = TryCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
               btr.AppendEntity(Me.Entity)
               tr.AddNewlyCreatedDBObject(Me.Entity, True)
               tr.Commit()
           End Using

       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ' Custom ArcTangent method, as the Math.Atan
   ' doesn't handle specific cases
   Public Shared Function Atan(ByVal y As Double, ByVal x As Double) As Double

       If x > 0 Then
           Return Math.Atan(y / x)
       ElseIf x < 0 Then
           Return Math.Atan(y / x) - Math.PI
       Else
           ' x == 0
           If y > 0 Then
               Return Math.PI
           ElseIf y < 0 Then
               Return -Math.PI
           Else
               ' if (y == 0) theta is undefined
               Return 0.0
           End If
       End If

   End Function

   ' Computes Angle between current direction
   ' (vector from last vertex to current vertex)
   ' and the last pline segment
   Public Shared Function ComputeAngle(ByVal startPoint As Point3d, ByVal endPoint As Point3d, ByVal xdir As Vector3d, ByVal ucs As Matrix3d) As Double
       Dim v As New Vector3d((endPoint.X - startPoint.X) / 2, (endPoint.Y - startPoint.Y) / 2, (endPoint.Z - startPoint.Z) / 2)
       Dim cos As Double = v.DotProduct(xdir)
       Dim sin As Double = v.DotProduct(Vector3d.ZAxis.TransformBy(ucs).CrossProduct(xdir))
       Return Atan(sin, cos)
   End Function

#End Region

#Region "Propriétés"

   ''' 
   ''' La polyligne du Jig
   ''' 
   ''' Renvoie Nothing si l'opération a été annulée
   Public Overloads ReadOnly Property Entity() As Entity
       Get
           If MyBase.Entity.IsDisposed Then Return Nothing
           Return MyBase.Entity
       End Get
   End Property

   ''' 
   ''' Autorise les arcs dans le Jig
   ''' 
   Public WriteOnly Property allowArc() As Boolean
       Set(ByVal value As Boolean)
           _allowArc = value
       End Set
   End Property

   ''' 
   ''' Le click droit valide et ferme la polyligne par un segment droit
   ''' 
   Public WriteOnly Property RigthClickClose() As Boolean
       Set(ByVal value As Boolean)
           _RigthClickClose = value
       End Set
   End Property

#End Region

End Class

bazoul · le 3 mai 2011

Salut l'ami.

Je te propose cette classe.Bon je te l'accorde ya un peu de ménage a faire dans le code ( genre des commentaires inutiles et des commentaires utile qui sont absent! )

Maintenant,si tu as aucune notion dans le langage ce code risque d'etre un peu compliqué,analyse un peu ce qu'il fait,et si besoin demande des précisions.

La code est en managé:

''' 
''' Class permettant de créer une polyligne en intégrant les arcs
''' 
''' Source : http://through-the-interface.typepad.com/through_the_interface/2010/12/jigging-an-autocad-polyline-with-arc-segments-using-net.html
Public Class BulgePolyJig
   Inherits EntityJig

#Region "Déclaration interne"

   Private _tempPoint As Point3d = Nothing
   Private _plane As Plane = Nothing
   Private _isArcSeg As Boolean = False
   Private _isUndoing As Boolean = False
   Private _isClosed As Boolean = False
   Private _allowArc As Boolean = False
   Private _RigthClickClose As Boolean = False
   Private _ucs As Matrix3d = Nothing
   Private _MiddlePoint As Point3d = Nothing

#End Region

   Private mLineTypeId As ObjectId = GetLineTypeIdFromLineTypeName("CACHE")

   ''' 
   ''' Constructeur
   ''' 
   ''' SCU dans lequel faire les calculs
   ''' Type de ligne
   Public Sub New(ByVal ucs As Matrix3d, ByVal LineTypeName As String)
       MyBase.New(New Polyline)
       Dim pline As Polyline = Nothing
       Dim normal As Vector3d = Nothing

       Try
           mLineTypeId = GetLineTypeIdFromLineTypeName(LineTypeName)
           _ucs = ucs
           normal = Vector3d.ZAxis.TransformBy(ucs)
           _plane = New Plane(Point3d.Origin, normal)
           pline = TryCast(Me.Entity, Polyline)
           pline.SetDatabaseDefaults()
           pline.Normal = normal
           AddDummyVertex()

       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Constructeur
   ''' 
   ''' Type de ligne
   ''' Le scu utilisé pour les calculs est le scu courant.
   Sub New(Optional ByVal LineTypeName As String = "")
       MyBase.New(New Polyline)
       Dim pline As Polyline = Nothing
       Dim normal As Vector3d = Nothing
       Try
           If LineTypeName.Trim <> "" Then mLineTypeId = GetLineTypeIdFromLineTypeName(LineTypeName)
           _ucs = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.CurrentUserCoordinateSystem
           normal = Vector3d.ZAxis.TransformBy(_ucs)
           _plane = New Plane(Point3d.Origin, normal)
           pline = TryCast(Me.Entity, Polyline)
           pline.SetDatabaseDefaults()
           pline.Normal = normal
           AddDummyVertex()
       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Récupérer l'objetID d'un type de ligne à partir de son nom
   ''' 
   ''' Nom du type de ligne
   ''' ObjectId du type de ligne
   Protected Function GetLineTypeIdFromLineTypeName(ByVal TypeName As String) As ObjectId
       Dim db As Database = Nothing
       Dim tm As DBTransMan = Nothing
       Dim tr As Transaction = Nothing
       Dim bt As LinetypeTable = Nothing
       'gestion de la transaction
       Try
           db = HostApplicationServices.WorkingDatabase
           tm = db.TransactionManager
           tr = tm.StartTransaction
           bt = CType(tm.GetObject(db.LinetypeTableId, OpenMode.ForRead, False), LinetypeTable)

           Return bt.Item(TypeName)
           ''Dim btr As LinetypeTableRecord = CType(tm.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), LinetypeTableRecord)
       Catch
           Return Nothing
       Finally
           If Not tr Is Nothing Then tr.abort() : tr.dispose()
       End Try



   End Function

   Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
       Dim jigOpts As New JigPromptPointOptions()
       Dim pline As Polyline = Nothing
       Dim msgAndKwds As String = ""
       Dim kwds As String = ""
       Dim res As PromptPointResult = Nothing
       Try

           jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NullResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)
           _isUndoing = False
           pline = TryCast(Me.Entity, Polyline)

           If pline.NumberOfVertices = 1 Then

               ' For the first vertex, just ask for the point
               jigOpts.Message = vbLf & "Sélectionner le point de départ :"

           ElseIf pline.NumberOfVertices > 1 Then

               If _isArcSeg Then
                   If _MiddlePoint.X = 0 AndAlso _MiddlePoint.Y = 0 AndAlso _MiddlePoint.Z = 0 Then
                       msgAndKwds = "Sélectionner le point se trouvant sur l'arc ou [undo]: "
                       kwds = "Undo"
                   Else
                       msgAndKwds = "Sélectionner le point d'arrivé de l'arc ou [Line/Undo/Clore]: "
                       kwds = "Line Undo Clore"
                   End If
               Else
                   If _allowArc Then
                       msgAndKwds = vbLf & "Sélectionner le point suivant ou [Arc/Undo/Clore]: "
                       kwds = "Arc Undo Clore"
                   Else
                       msgAndKwds = vbLf & "Sélectionner le point suivant ou [undo/Clore]: "
                       kwds = "Undo Clore"
                   End If
               End If

               jigOpts.SetMessageAndKeywords(msgAndKwds, kwds)
               Else
                   Return SamplerStatus.Cancel
               End If
           ' Should never happen
           ' Get the point itself

           res = prompts.AcquirePoint(jigOpts)
           If res.Status = PromptStatus.Keyword Then

               If res.StringResult.ToUpper() = "ARC" Then
                   _isArcSeg = True
               ElseIf res.StringResult.ToUpper() = "LINE" Then
                   _isArcSeg = False
               ElseIf res.StringResult.ToUpper() = "UNDO" Then
                   _isUndoing = True
                   _isArcSeg = False
               ElseIf res.StringResult.ToUpper() = "CLORE" Then
                   _isClosed = True
               Else
                   MsgBox("Error")
               End If
               Return SamplerStatus.OK

           ElseIf res.Status = PromptStatus.OK Then

               ' Check if it has changed or not (reduces flicker)
               If _tempPoint = res.Value Then
                   Return SamplerStatus.NoChange
               Else
                   _tempPoint = res.Value
                   Return SamplerStatus.OK
               End If
           ElseIf res.Status = PromptStatus.None Then
               If pline.NumberOfVertices <= 1 Then
                   Return SamplerStatus.Cancel
               End If

               If _RigthClickClose Then
                   _isClosed = True
               End If
               Return SamplerStatus.OK
           End If
           Return SamplerStatus.Cancel
       Catch ex As Exception
           Throw ex
       End Try

   End Function

   ''' 
   ''' Fonction de mise a jour du jig
   ''' 
   Protected Overrides Function Update() As Boolean
       Dim pl As Polyline = Nothing
       Dim refDir As Vector3d = Nothing
       Dim lastVertex As Point3d = Nothing, pt As Point3d = Nothing
       Dim arcSegment As CircularArc3d = Nothing
       Dim tangent As Line3d = Nothing
       Dim angle As Double = 0, bulge As Double = 0
       Try
           ' Update the dummy vertex to be our 3D point
           ' projected onto our plane
           pl = TryCast(Me.Entity, Polyline)
           If _isArcSeg Then

               'Si le point du milieu n'est pas défini en mode arc,alors l'utilisateur doit cliquer un point de l'arc
               If _MiddlePoint.X = 0 AndAlso _MiddlePoint.Y = 0 AndAlso _MiddlePoint.Z = 0 Then
                   pl.SetBulgeAt(pl.NumberOfVertices - 2, 0)
               Else

                   'Le point du milieu est défini,alors on dessine l'arc passant par le point du milieu
                   lastVertex = pl.GetPoint3dAt(pl.NumberOfVertices - 2)
                   If pl.NumberOfVertices < 3 Then
                       refDir = New Vector3d(1.0, 1.0, 0.0)
                       pt = pl.GetPoint3dAt(pl.NumberOfVertices - 2)
                       refDir = New Vector3d(_MiddlePoint.X - pt.X, _MiddlePoint.Y - pt.Y, _MiddlePoint.Z - pt.Z)
                   Else
                       ' Check bulge to see if last segment was an arc or a line
                       If pl.GetBulgeAt(pl.NumberOfVertices - 3) <> 0 Then
                           arcSegment = pl.GetArcSegmentAt(pl.NumberOfVertices - 3)
                           tangent = arcSegment.GetTangent(lastVertex)
                           ' Reference direction is the invert of the arc tangent
                           ' at last vertex
                           refDir = tangent.Direction.MultiplyBy(-1.0)
                       Else
                           pt = pl.GetPoint3dAt(pl.NumberOfVertices - 2)
                           refDir = New Vector3d(_MiddlePoint.X - pt.X, _MiddlePoint.Y - pt.Y, _MiddlePoint.Z - pt.Z)
                       End If
                   End If
                   angle = ComputeAngle(_MiddlePoint, _tempPoint, refDir, _ucs)
                   ' Bulge is defined as tan of one fourth of included angle
                   ' Need to double the angle since it represents the included
                   ' angle of the arc
                   ' So formula is: bulge = Tan(angle * 2 * 0.25)
                   bulge = Math.Tan(angle * 0.5)
                   pl.SetBulgeAt(pl.NumberOfVertices - 2, bulge)

               End If
           Else
               'en mode LINE,on remet a vide le point du milieu
               _MiddlePoint = Nothing
               ' Line mode. Need to remove last bulge if there was one
               If pl.NumberOfVertices > 1 Then
                   pl.SetBulgeAt(pl.NumberOfVertices - 2, 0)
               End If
           End If
           pl.SetPointAt(pl.NumberOfVertices - 1, _tempPoint.Convert2d(_plane))
           Return True
       Catch ex As Exception
           Return False
       End Try

   End Function


#Region "Partie Publique"

   ''' 
   ''' Permet de saisir une polyligne dans autocad
   ''' 
   Public Sub Draw()
       Dim ed As Editor = Nothing
       Dim jig As BulgePolyJig = Nothing
       Dim res As PromptResult = Nothing
       Try
           ed = Application.DocumentManager.MdiActiveDocument.Editor
           While True
               res = ed.Drag(Me)
               Select Case res.Status
                   ' New point was added, keep going
                   Case PromptStatus.OK
                       AddDummyVertex()
                       Exit Select
                       ' Keyword was entered
                   Case PromptStatus.Keyword
                       If _isUndoing Then
                           RemoveLastVertex()
                       End If

                       If _isClosed Then
                           ClosePolyline()
                           Exit While
                       End If

                       Exit Select
                       ' If the jig completed successfully, add the polyline
                   Case PromptStatus.None
                       If _isClosed Then
                           ClosePolyline()
                       Else
                           RemoveLastVertex()
                       End If
                       Exit While
                   Case Else
                       ' User cancelled the command, get out of here
                       ' and don't forget to dispose the jigged entity
                       Me.Entity.Dispose()
                       Exit While
               End Select
           End While
       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Ajoute un point nul a la polyligne
   ''' 
   ''' Aucune idée de pourquoi
   Public Sub AddDummyVertex()
       Dim pline As Polyline = Nothing
       Try
           pline = TryCast(Me.Entity, Polyline)
           If _isClosed Then Return
           ' Create a new dummy vertex... can have any initial value

           'On est sur un arc
           If _isArcSeg Then
               'Si le point milieu est vide alors on affecte le dernier point en tant que point milieu
               If _MiddlePoint.X = 0 AndAlso _MiddlePoint.Y = 0 AndAlso _MiddlePoint.Z = 0 Then
                   _MiddlePoint = pline.GetPoint3dAt(pline.NumberOfVertices - 1)
               Else
                   pline.AddVertexAt(pline.NumberOfVertices, New Point2d(0, 0), 0, 0, 0)
                   _isArcSeg = False
               End If
           Else
               pline.AddVertexAt(pline.NumberOfVertices, New Point2d(0, 0), 0, 0, 0)
           End If

       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ''' 
   ''' Supprime le dernier sommet de la polyligne
   ''' 
   Public Sub RemoveLastVertex()
       Dim pline As Polyline = Nothing
       Dim blg As Double = 0

       Try
           pline = TryCast(Me.Entity, Polyline)
           ' Let's first remove our dummy vertex   
           If pline.NumberOfVertices <= 1 Then
               Entity.Dispose()
               Exit Sub
           End If
           ' And then check the type of the last segment
           If pline.NumberOfVertices >= 2 Then
               blg = pline.GetBulgeAt(pline.NumberOfVertices - 2)
               pline.RemoveVertexAt(pline.NumberOfVertices - 1)
               _isArcSeg = (blg <> 0)
           End If


       Catch ex As Exception
           Throw ex
       End Try

   End Sub

   ''' 
   ''' Ferme la polyligne
   ''' 
   ''' Prends en compte si le dernier segment est une ligne ou un arc
   Public Sub ClosePolyline()
       Dim pline As Polyline = Nothing
       Dim blg As Double = 0
       Dim pt As Point3d, lastVertex As Point3d
       Dim refDir As Vector3d
       Dim angle As Double, bulge As Double
       Try

           pline = TryCast(Me.Entity, Polyline)

           If _isArcSeg Then
               lastVertex = pline.GetPoint3dAt(pline.NumberOfVertices - 2)
               ' Check bulge to see if last segment was an arc or a line
               If pline.GetBulgeAt(pline.NumberOfVertices - 3) <> 0 Then
                   refDir = pline.GetArcSegmentAt(pline.NumberOfVertices - 3).GetTangent(lastVertex).Direction.MultiplyBy(-1.0)
               Else
                   pt = pline.GetPoint3dAt(pline.NumberOfVertices - 2)
                   refDir = New Vector3d(_MiddlePoint.X - pt.X, _MiddlePoint.Y - pt.Y, _MiddlePoint.Z - pt.Z)
               End If

               angle = ComputeAngle(_MiddlePoint, pline.GetPoint3dAt(0), refDir, _ucs)
               ' Bulge is defined as tan of one fourth of included angle
               ' Need to double the angle since it represents the included
               ' angle of the arc
               ' So formula is: bulge = Tan(angle * 2 * 0.25)
               bulge = Math.Tan(angle * 0.5)
               pline.SetBulgeAt(pline.NumberOfVertices - 2, bulge)
           End If

           'Le dernier point correspond toujours au point temporaire de la position de la souris
           pline.RemoveVertexAt(pline.NumberOfVertices - 1)
           pline.Closed = True : _isClosed = True

       Catch ex As Exception
           Throw ex
       End Try

   End Sub

   ''' 
   ''' Ajoute la polyligne au ModelSpace
   ''' 
   Public Sub Append()
       Dim bt As BlockTable = Nothing
       Dim btr As BlockTableRecord = Nothing

       Try
           Using tr As Transaction = HostApplicationServices.WorkingDatabase.TransactionManager.StartTransaction
               bt = TryCast(tr.GetObject(HostApplicationServices.WorkingDatabase.BlockTableId, OpenMode.ForRead), BlockTable)
               btr = TryCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
               btr.AppendEntity(Me.Entity)
               tr.AddNewlyCreatedDBObject(Me.Entity, True)
               tr.Commit()
           End Using

       Catch ex As Exception
           Throw ex
       End Try
   End Sub

   ' Custom ArcTangent method, as the Math.Atan
   ' doesn't handle specific cases
   Public Shared Function Atan(ByVal y As Double, ByVal x As Double) As Double

       If x > 0 Then
           Return Math.Atan(y / x)
       ElseIf x < 0 Then
           Return Math.Atan(y / x) - Math.PI
       Else
           ' x == 0
           If y > 0 Then
               Return Math.PI
           ElseIf y < 0 Then
               Return -Math.PI
           Else
               ' if (y == 0) theta is undefined
               Return 0.0
           End If
       End If

   End Function

   ' Computes Angle between current direction
   ' (vector from last vertex to current vertex)
   ' and the last pline segment
   Public Shared Function ComputeAngle(ByVal startPoint As Point3d, ByVal endPoint As Point3d, ByVal xdir As Vector3d, ByVal ucs As Matrix3d) As Double
       Dim v As New Vector3d((endPoint.X - startPoint.X) / 2, (endPoint.Y - startPoint.Y) / 2, (endPoint.Z - startPoint.Z) / 2)
       Dim cos As Double = v.DotProduct(xdir)
       Dim sin As Double = v.DotProduct(Vector3d.ZAxis.TransformBy(ucs).CrossProduct(xdir))
       Return Atan(sin, cos)
   End Function

#End Region

#Region "Propriétés"

   ''' 
   ''' La polyligne du Jig
   ''' 
   ''' Renvoie Nothing si l'opération a été annulée
   Public Overloads ReadOnly Property Entity() As Entity
       Get
           If MyBase.Entity.IsDisposed Then Return Nothing
           Return MyBase.Entity
       End Get
   End Property

   ''' 
   ''' Autorise les arcs dans le Jig
   ''' 
   Public WriteOnly Property allowArc() As Boolean
       Set(ByVal value As Boolean)
           _allowArc = value
       End Set
   End Property

   ''' 
   ''' Le click droit valide et ferme la polyligne par un segment droit
   ''' 
   Public WriteOnly Property RigthClickClose() As Boolean
       Set(ByVal value As Boolean)
           _RigthClickClose = value
       End Set
   End Property

#End Region

End Class

david541 · le 3 mai 2011

Merci a tous pour vos réponse, mais hélas, elles ne viennent pas afficher! pourquoi???

Connexion

Bloc+attribut --> Espace_ADT

Messages recommandés

mikl63

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

lili2006

rebcao

didier

rebcao

FormaBois

FormaBois

lili2006

bryce

gloups

La Lozère

Steven

lili2006

mikl63

wookichu

Marcooo

djn06

Steven

bexkivr

wookichu

wookichu

Dinosor

bazoul

bazoul

david541

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante