#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
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
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
Re: ArcPad 8.0 - Découpe de polylignes
arf je n'ai pas trop le temps de vous faire une formation j'avoue
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
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