banniere

Le portail francophone de la géomatique


Toujours pas inscrit ? Mot de passe oublié ?
Nom d'utilisateur    Mot de passe              Toujours pas inscrit ?   Mot de passe oublié ?

#1 Mon 06 June 2011 14:55

Leon Baanders
Juste Inscrit !
Lieu: Elst, Pays-Bas
Date d'inscription: 6 Jun 2011
Messages: 5

ArcPad 8.0 - Découpe de polylignes

Bonjour,

Dans le cadre d'un projet d'inventaire de sentiers pédestres, je cherche à pouvoir découper des polylignes dans ArcPad 8.0. Il existe une petite application "Cut" (livrée avec le logiciel par ESRI) qui permet de découper des polylignes à l'aide d'une ligne dans un autre fichier shape. Cependant, cette application a un défaut important: elle ne coupe pas qu'une seule ligne. Lorsque je trace une ligne pour découper une seule polyligne dans mon shapefile, ArcPad la prolonge à l'infini, découpant ainsi toutes les polylignes qui croisent cette ligne. J'ai la possibilité d'annuler la découpe de chacune de ces polylignes, mais ce travail est très laborieux (il faut le faire pour chaque polyligne individuellement) et cela multiplie le risque d'erreur humaine.

Existe-t-il un moyen de découper une seule polyligne à la fois dans ArcPad? Est-ce simplement quelques lignes à programmer dans ArcPad Studio? Ou connaissez-vous un autre moyen de le faire?

Merci d'avance.

Hors ligne

 

#2 Mon 06 June 2011 15:26

Forestis
Participant assidu
Lieu: Aniane (Hérault)
Date d'inscription: 5 Sep 2005
Messages: 168
Site web

Re: ArcPad 8.0 - Découpe de polylignes

hélas j'ai eu le même problème et je n'ai pas trouvé de solution. Dans mon souvenir, pour avoir adapté la prog de l'outil a mes besoins, ce "cut" ne fonctionne qu'avec une ligne infinie. Par contre on peut, il me semble, limiter la coupure au polygone ou la polyligne selectionné. J'ai également fait en sorte d'afficher le résultat de la découpe avec un message de confirmation.

Dernière modification par Forestis (Mon 06 June 2011 15:31)


[Matthieu Pette - Ad Terram] (@Ad_Terram sur le PiouPiou bleu)

~Géomaticien Indépendant~

Hors ligne

 

#3 Mon 06 June 2011 15:37

Forestis
Participant assidu
Lieu: Aniane (Hérault)
Date d'inscription: 5 Sep 2005
Messages: 168
Site web

Re: ArcPad 8.0 - Découpe de polylignes

Bon bin voila je suis bon et je vous offre mon code ^^ :-)
Si quelqu'un trouve un moyen de le perfectionner je suis preneur.

Code:

Option Explicit
Dim MonPremierPoint
Dim MonSecondPoint
Dim MaLigne

Sub Init_Apa
        Set MaLigne = Nothing
        Set MonPremierPoint = Nothing
        Set MonSecondPoint = Nothing
end sub


Sub CutPolygon

    Dim MonBookMark
    MonBookMark = Application.Map.SelectionBookmark
    if MonBookMark = 0 then 
        msgbox "Selectionnez un polygone"
        exit sub
    end if

    Dim pSymbol
    Set pSymbol = Application.CreateAppObject("Symbol")
    pSymbol.MarkerStyle = 3 'cross
    pSymbol.MarkerSize = 10
    pSymbol.MarkerAngle = 0
    pSymbol.LineColor = 0 'black
    pSymbol.LineWidth = 2
    pSymbol.FillStyle = 0 'solid
    pSymbol.FillColor = 0 'Black
    Set MonSecondPoint = Application.CreateAppObject("Point")

    if MonPremierPoint Is Nothing then
        Map.Extent = Map.Extent
        Set MonPremierPoint = Application.CreateAppObject("Point")
        MonPremierPoint.x = Map.PointerX
        MonPremierPoint.y = Map.PointerY
        Call Map.DrawShape(MonPremierPoint, pSymbol)
    else
        Map.Extent = Map.Extent
        Dim pPoints,pSymbol2
        Set pSymbol2 = Application.CreateAppObject("Symbol")
        'Modify the symbol object for drawing the line
        pSymbol2.LineColor = 4210816      'brown
        pSymbol2.LineWidth = 2
        
        'Create a points collection and point object
        MonSecondPoint.x = Map.PointerX
        MonSecondPoint.y = Map.PointerY
        
        'Populate the points collection
        Set pPoints = Application.CreateAppObject("Points")
        pPoints.Add MonPremierPoint
        pPoints.Add MonSecondPoint
        
        'Create a line object and add the points collection to it
        Set MaLigne = Application.CreateAppObject("Line")
        Call MaLigne.Parts.Add(pPoints)
        
        'Draw the line with the updated symbology
        Call Map.DrawShape(MonSecondPoint, pSymbol)        
        Call Map.DrawShape(MaLigne, pSymbol2)

        Dim objSelLayer
        Set objSelLayer = Map.SelectionLayer
        Dim objRs',objRS2
        Set objRS = objSelLayer.Records
        'Set objRS2 = objSelLayer.Records

        objRS.Bookmark = MonBookMark
        Dim MonTableauPoly
        MonTableauPoly = objRS.Fields.Shape.Cut(MaLigne)
        if MonTableauPoly(0) Is Nothing Or MonTableauPoly(1) Is Nothing then 
            Set MaLigne = Nothing
            Set MonSecondPoint = Nothing
            Set MonPremierPoint = Nothing
            Set pSymbol = Nothing
            set objRS=nothing
            Set MaLigne = Nothing
            Set objSelLayer = Nothing
            Map.Extent = Map.Extent
            exit sub
        end if
        'set up sumbology for split feature
        Dim sym
        Set sym = Application.CreateAppObject("Symbol")
        sym.FillStyle = 0
        sym.LineWidth = 3
        sym.LineColor = sym.makecolor(0,0,255)         ' blue
        sym.FillColor = sym.makecolor(0,220,255)     ' cyan

        'Draw the polygons on the map
        call Map.DrawShape(MonTableauPoly(0), sym)
        call Map.DrawShape(MonTableauPoly(1), sym)
        call Map.Refresh

        If MsgBox("Etes vous sûr de vouloir couper ce polygone",vbYesNo,"QUIT?") = vbYes Then
            
            Dim MonNombreDeChamps
            MonNombreDeChamps = cint(objRS.Fields.count)
            Dim MonTableauValeur ()
            Redim MonTableauValeur (MonNombreDeChamps-3)
            Dim MonCompte    
            For MonCompte=0 to objRS.Fields.count-3
                MonTableauValeur(MonCompte) = objRS.Fields(MonCompte+2).Value 
            Next
            objRS.delete

            objRS.AddNew (MonTableauPoly(0))
            For MonCompte=0 to objRS.Fields.count-3
                 if objRS.Fields(MonCompte+2).name <> "Shape" then objRS.Fields(MonCompte+2).Value = MonTableauValeur(MonCompte)
            Next
            'Update the new record to save the changes
            objRS.Update

            objRS.AddNew (MonTableauPoly(1))
            For MonCompte=0 to objRS.Fields.count-3
                 if objRS.Fields(MonCompte+2).name <> "Shape" then objRS.Fields(MonCompte+2).Value = MonTableauValeur(MonCompte)
            Next
            'Update the new record to save the changes
            objRS.Update
        end if
        Set MaLigne = Nothing
        Set MonPremierPoint = Nothing
        Set MonSecondPoint = Nothing
        Set pSymbol = Nothing
        set objRS=nothing
        Set MaLigne = Nothing
        Set objSelLayer = Nothing
        Map.Extent = Map.Extent
    end if
end sub

[Matthieu Pette - Ad Terram] (@Ad_Terram sur le PiouPiou bleu)

~Géomaticien Indépendant~

Hors ligne

 

#4 Tue 07 June 2011 12:08

Leon Baanders
Juste Inscrit !
Lieu: Elst, Pays-Bas
Date d'inscription: 6 Jun 2011
Messages: 5

Re: ArcPad 8.0 - Découpe de polylignes

Merci pour votre code. Cependant, n'étant pas expert en ArcPad, pourriez-vous m'expliquer comment l'activer une fois ArcPad ouvert? Faut-il passer par une application? Ou faut-il simplement le copier dans ArcPad?

Hors ligne

 

#5 Tue 07 June 2011 13:17

Forestis
Participant assidu
Lieu: Aniane (Hérault)
Date d'inscription: 5 Sep 2005
Messages: 168
Site web

Re: ArcPad 8.0 - Découpe de polylignes

arf je n'ai  pas trop le temps de vous faire une formation j'avoue wink
ce que je peux vous dire rapidement c'est qu'il faut utiliser arcpad studio,
- créer une applet et mettre dans l'event onload "Call Init_Apa"
- créer une barre d'outil dans cette applet avec un nouveau bouton (add custom).
- Dans les propriétés de ce bouton sur le code de l'event onpointerdown il faut mettre "Call CutPolygon"
ensuite il suffit de mettre l'apa et le vbs de l’applet dans le répertoire des applets d'arcpad

bon courage


[Matthieu Pette - Ad Terram] (@Ad_Terram sur le PiouPiou bleu)

~Géomaticien Indépendant~

Hors ligne

 

#6 Tue 07 June 2011 14:52

Leon Baanders
Juste Inscrit !
Lieu: Elst, Pays-Bas
Date d'inscription: 6 Jun 2011
Messages: 5

Re: ArcPad 8.0 - Découpe de polylignes

Après quelques essais j'ai réussi à le faire fonctionner. Je vois la barre d'outils et je peux découper des lignes, mais j'ai deux fois le bouton sur la barre d'outils. Si quelqu'un sait d'où ça peut venir, je suis preneur. Sinon ce n'est pas grave, l'outil fonctionne correctement.

En tout cas merci de votre aide, ça va nous permettre d'accélerer le projet.

Hors ligne

 

#7 Tue 07 June 2011 15:36

Forestis
Participant assidu
Lieu: Aniane (Hérault)
Date d'inscription: 5 Sep 2005
Messages: 168
Site web

Re: ArcPad 8.0 - Découpe de polylignes

a part si vous l'avez amené deux fois dans la barre d'outil ou si vous avez enregistré deux fois l'applet avec des noms différents, je vois pas.


[Matthieu Pette - Ad Terram] (@Ad_Terram sur le PiouPiou bleu)

~Géomaticien Indépendant~

Hors ligne

 

Pied de page des forums

Powered by FluxBB