Création d'une Polyligne sans clics

[fabcad]

Bonsoir à tous,

 

J'ai trouvé ce génial programme qui permet de créer plusieurs perpendiculaires par rapport à la polyligne tout en faisant glisser la souris sur cette polyligne, c'est ce qui m'épate et donc j'ai imaginé prendre ce concept pour créer une polyligne sans cliquer les points des extrémités de polylignes dont elle serait issue.

 

Voici l’algorithme de la fonction rêvée :

Algorithme :

- Sélection d'une "curve" et d'un point de départ.

- Tant que le clic n'a pas pris de point "forcé" (accroche proche) sur le segment alors prise des sommets au fur et à mesure du passage de la souris sur l'objet en cours.

- Si une intersection est trouvée, continuer si l'objet en cours le permet ou demander à l'utilisateur de choisir un autre objet curve.

- Et ainsi de suite jusqu'à la pression d'une d’arrêt prévue par le programme.

 

Merci d'avance, elle permettra des créations de polylignes de surfaces très rapidement pour l'utilisateur.

VovKa_LPer.lsp

[bonuscad]

Bonjour,

 

Un embryon de code pour donner une piste, comme je sais que tu fais un peu de lisp, peut être que tu pourra approfondir le dev... (je n'ai pas trop de temps pour le faire moi même)

 

(defun round (num prec)
 (if (zerop (setq prec (abs prec)))
   num
   (* prec (fix ((if (minusp num) - +) (/ num prec) 0.5)))
 )
)
(defun c:test ( / cur_color key pt_sel ss ent obj_lw param_pt new_param pt lst_pt)
 (setq
   new_param nil
   ent nil
   lst_pt nil
   cur_color (getvar "CECOLOR")
 )
 (setvar "CECOLOR" "1")
 (command "_.PLINE")
 (while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25))
   (setq
     pt_sel (osnap (list (caadr key) (cadadr key)) "_near")
   )
   (if pt_sel
     (progn
       (setq ss (ssget "_C" pt_sel pt_sel '((0 . "LWPOLYLINE"))))
       (if ss (setq ent (ssname ss 0)))
     )
   )
   (cond
     (ent 
       (setq
         obj_lw (vlax-ename->vla-object ent)
         pt_sel (vlax-curve-getClosestPointTo obj_lw (trans (cadr key) 1 0))
       )
       (cond
         (pt_sel
           (setq
             param_pt (vlax-curve-getParamAtPoint obj_lw pt_sel)
             param_pt (round param_pt 1.0)
           )
           (cond
             (new_param
               (setq pt (vlax-curve-getPointAtParam obj_lw param_pt))
               (if (and (not (eq param_pt new_param)) (not (member pt lst_pt)))
                 (progn
                   (setq lst_pt (cons pt lst_pt))
                   (command "_none" (trans pt 0 1))
                 )
               )
             )
           )
           (setq new_param param_pt)
         )
       )
     )
   )
 )
 (command "")
 (setvar "CECOLOR" cur_color)
 (prin1)
)

Modifié le 28 octobre 2014 par bonuscad

[fabcad]

Bonsoir,

 

Merci Bonuscad pour cet embryon de programme, j’essayerai de l'approfondir c'est quand même un très grand pas.

 

Bonne soirée,

[bonuscad]

J'ai voulu tester en cas réel, c'est à dire sur une feuille parcellaire comme si je voulais dessiner un zonage de POS.

 

Et bien ça demande beaucoup de dextérité sur le maniement de la souris car les sommets sont vites générés.

L'utilisation du zoom molette est vicieux car alors le curseur capte des sommets non désirés lors du zoom...

Avec les segment de polyarc, cela ne fonctionne pas, (mais cela est rare dans du parcellaire).

 

Je me suis aperçu aussi que les sommets pouvaient être générés plusieurs fois sans que cela se voit. Pour ce problème j'ai pu le corriger facilement (j'édite le code précédent)

 

Je pense que la possibilité d'un "U" serait le bienvenu dans la boucle pour palier à une génération impromptue d'un segment. L'intégration dans (grread) risque d'être coton. Si j'ai un peu de temps je regarderais ça...

[fabcad]

Merci Bonuscad,

 

:-) Tu as lu dans mes pensées car c'est effectivement lors de la création de zonages POS/PLU ou des des demandes de surfaces issues de plusieurs parcelles.

 

J'ai testé la fonction hier soir et effectivement un ajout de points au même endroit se fait sur des sommets mais c'est quand même grandiose.

 

Pour info : Je connais AutoLISP mais je ne maitrise pas beaucoup la partie géométrie, j'ai réalisé des fonctions mais dans le domaine des chaines de caractères et des données attributaires sur AutoCAD MAP.

 

Merci beaucoup,

 

Bonne journée,

 

Fabrice

[bonuscad]

Pendant la pause déjeuner j'ai essayer d'intégrer le "U" pour l'annulation.

J'ai du revoir un peu le montage du code pour cela, le pan ou le zoom avec la roulette reste toujours un problème avec (grread): l'appui sur la molette n'est pas reconnu, donc je ne peux pas l'identifier...

Donc éviter au maximum l'usage de la roulette, maintenant le U permettra quand même d'annuler les segments générés pendant l'usage de celle-ci

Il faut quand même une bonne dextérité pour l'usage, mais ça à l'air de fonctionner.

 

Pour l'annulation l'appui sur la touche "U" suffit: NE PAS FAIRE ENTREE pour valider.

Le code résultant:

 

(defun round (num prec)
 (if (zerop (setq prec (abs prec)))
   num
   (* prec (fix ((if (minusp num) - +) (/ num prec) 0.5)))
 )
)
(defun c:test ( / p1 p2 key pt_sel ss ent obj_lw param_pt new_param pt lst_pt lst_gr)
 (initget 1)
 (setq
   p1 (getpoint "\nPoint de départ: ")
   new_param nil
   ent nil
   lst_pt nil
   lst_gr nil
 )
 (while (and (setq key (grread T 4 0)) (not (member key '((2 13) (2 32)))) (/= (car key) 25))
   (cond
     ((eq (car key) 5)
       (setq
         pt_sel (osnap (list (caadr key) (cadadr key)) "_near")
       )
       (if pt_sel
         (progn
           (setq ss (ssget "_C" pt_sel pt_sel '((0 . "LWPOLYLINE"))))
           (if ss (setq ent (ssname ss 0)))
         )
       )
       (cond
         (ent 
           (setq
             obj_lw (vlax-ename->vla-object ent)
             pt_sel (vlax-curve-getClosestPointTo obj_lw (trans (cadr key) 1 0))
           )
           (cond
             (pt_sel
               (setq
                 param_pt (vlax-curve-getParamAtPoint obj_lw pt_sel)
                 param_pt (round param_pt 1.0)
               )
               (cond
                 (new_param
                   (setq pt (vlax-curve-getPointAtParam obj_lw param_pt))
                   (if (and (not (eq param_pt new_param)) (not (member pt lst_pt)))
                     (progn
                       (setq lst_pt (cons (trans pt 0 1) lst_pt))
                       (setq p2 (trans pt 0 1))
                       (setq lst_gr (append (cons 1 (list p1 p2)) lst_gr))
                       (grvecs lst_gr)
                       (setq p1 p2)
                     )
                   )
                 )
               )
               (setq new_param param_pt)
             )
           )
         )
       )
     )
     ((member key '((2 117)(2 85)))
       (if lst_gr
         (setq
           lst_gr (cdddr lst_gr)
           lst_pt (cdr lst_pt)
           p1 (car lst_pt)
         )
       )
       (redraw)
       (grvecs lst_gr)
     )
     (T
       (if lst_gr (grvecs lst_gr))
     )
   )
 )
 (redraw)
 (cond
   (lst_pt
     (setvar "CMDECHO" 0)
     (command "_.pline")
     (foreach n lst_pt (command "_none" n))
     (command "")
     (setvar "CMDECHO" 1)
     (sssetfirst nil (ssadd (entlast)))
   )
 )
 (prin1)
)

[fabcad]

Bonsoir,

 

Merci pour l’intérêt que tu porte à concevoir cette routine très utile.

On m'a demandé de créer des surfaces d’après des parcelles et j'ai donc pu tester la fonction, j'ai zoomé sur ma zone de travail afin de ne pas utiliser la molette.

L'ajout de la sélection du point de départ est très bien car on voit tout de suite où partir, après il faut aller doucement pour ne pas oublier un segment.

 

Merci encore,

 

Fabrice