changer de calque un objet d\'une selection

[oplotcha]

bonjour.

 

je crée actuellement un filtre pour qu'un nuage de points soit filtré en points au sol et points végétation en VBA Autocad Map3D 2008.

 

Mon problème se situe pour le déplacement d'un calque à un autre d'un objet appartenant à une selection créée précédement.

J'arrive à modifier la couleur de l'objet, à obtenir le calque dans lequel il se situe mais pas à le déplacer dans un autre calque.

 

mon programme:

 

Dim BaSelectv As AcadSelectionSet

Dim pointsolv As Variant

ReDim pointsolv(2)

Dim Pt1v(0 To 2) As Double

Dim Pt2v(0 To 2) As Double

Dim IIv As Integer

Dim IIIv As Integer

Dim pointxv As Variant

Dim pointxiv(0 To 2) As Double

 

 

'Donnees : coordonnées de la fenetre

Pt1v(0) = xmin - 1.5

Pt1v(1) = ymin - 1.5

Pt1v(2) = 0#

Pt2v(0) = xmin + 1.5

Pt2v(1) = ymin + 1.5

Pt2v(2) = 0#

'Creation du jeu de selection

On Error Resume Next

Set BaSelectv = ThisDrawing.SelectionSets.Item("BaVBav")

If Err Then

Err.Clear

Else

BaSelectv.Delete

End If

 

Set BaSelectv = ThisDrawing.SelectionSets.Add("BaVBav")

'Selection de toutes les entites dans la fenetre

BaSelectv.Select acSelectionSetWindow, Pt1v, Pt2v

'MsgBox (CStr(BaSelect.Count))

 

If BaSelectv.Count <> 0 Then

For IIv = 1 To BaSelectv.Count

pointsolv = BaSelectv.Item(IIv - 1).Coordinates

altiv = pointsolv(2)

sommealtiv = altiv + sommealtiv

Next IIv

moyenne1v = sommealtiv / BaSelectv.Count

 

For IIIv = 1 To BaSelectv.Count

pointaclasserv = BaSelectv.Item(IIIv - 1).Coordinates

If (pointaclasserv(2) - moyenne1v) < -5 Then

Countv = Countv + 1

 

BaSelectv.Item(IIIv - 1).color = acWhite

nomlayer = BaSelectv.Item(IIIv - 1).Layer

[surligneur] BaSelectv.Item(IIIv - 1).Layer = indéterminé_veget[/surligneur] BaSelectv.Item(IIIv - 1).Update

End If

Next IIIv

End If

 

[sechanbask]

j'ai l'impression que ton calque dans lequel tu veux mettre tes objet n'est pas créer, je me trompe ?

 

je te donnes 2 solutions : Comme au début, je ne savait qu'on pouvais déplacer de calque un objet, j'utilisais la méthode 1 puis j'ai utilisé le code précédent mais uniquement quand je veux déplacer 1 ou 2 objets.

 

méthode 1 :

 

récupérer le calque actif

dim strCalqueCourant as string
strCalqueCourant = ThisDrawing.ActiveLayer.Name

 

pour créer un calque

dim newlayer1 as acadlayer
Set newlayer1 = ThisDrawing.layers.Add("12-texte")

 

pour le rendre actif

ThisDrawing.ActiveLayer = ThisDrawing.layers("12-texte")

 

 

là je créé mes nouveaux objets qui arrivaient dans le calque actif : 12-texte

puis je remettais l'ancien calque

 

ThisDrawing.ActiveLayer = ThisDrawing.layers(strCalqueCourant)

 

 

et puis j'ai découvert la méthode 2:

 

pour mettre un objet dans un calque précis:

 Dim splineObj As AcadSpline
dim actlayer as string
actlayer = "12-texte"
With splineObj
  .Layer = actlayer
  .Update
  End With

 

j'espère que ça t'aidera. Bon courage !

[oplotcha]

Merci pour ta réponse rapide.

 

Helas la méthode deux ne fonctionne pas.

 

Mon calque est créé bien en amont dans mon programme. Et il est actif, non verroullié, non gelé.

 

 

Mes objets à déplacer sont des points dans des calques différents. ils font parti d'une sélection. Mais je veux mettre que quelques points parmi cette selection dans un autre claque

 

 BaSelectv        'ma selection
BaSelect.item(IIIv-1)         'un objet de ma selection

 

 Baselectv.item(IIIv-1).color=acWhite                        'fonctionne
Baselectv.item(IIIv-1).layer = indéterminé_veget     'ne fonctionne pas 

 

 namelayer = "indéterminé_veget"
                   With BaSelectv.Item(IIIv - 1)
                   .Layer = namelayer
                   .Update
                   End With'                  ne fonctionne pas

 

mais je n'ai pas de plantage. le programme termine sa tache en passant la ligne comme si ne rien n'était.

 

 

[oplotcha]

j'ai répondu un peu trop vite sans faire bien attention. après plusieurs tests, la deuxième méthode fonctionne.

 

merci beaucoup

[sechanbask]

de rien, nous sommes là pour ça... Puisque le sujet est résolu, indique le en cliquant sur l'ampoule en dessous de ton premier message (lorsque tu es loggé)..

Bonne continuation.