transformer polyligne en multiligne

[philous2]

Bjr,

 

J'ai une macro qui est censé transformer des polylignes en multilgne et ça ne marche pas vraiment.

Je charge le code "po2ml" et j'ai ça comme message "Commande: po2ml

Choix des polylignes à transformer en multilignes:

Sélection vide !!!!!!!"

Je n'ai pas l'occasion de sélectionner mes polylignes car j'ai ce message aussitôt que j'ai validé le code donc soucis

 

(defun po2ml ( / jspl nbr ent dxf_ent typent name_layer closed lst l_bub e_next dxf_next oldlayer oldosm key_mod scale_ml)

(princ "\nChoix des polylignes à transformer en multilignes: ")

(setq

jspl (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>")))

nbr 0

)

(cond

(jspl

(initget "Dessus Nulle dEssous _Top Zero Bottom")

(setq key_mod

(getkword

(strcat

"\nEntrez le type de justification [Dessus/Nulle/dEssous] <"

(cond

((eq (getvar "cmljust") 0)

"Dessus"

)

((eq (getvar "cmljust") 1)

"Nulle"

)

((eq (getvar "cmljust") 2)

"dEssous"

)

)

">: "

)

)

)

(if key_mod

(cond

((eq key_mod "Top") (setvar "cmljust" 0))

((eq key_mod "Zero") (setvar "cmljust" 1))

((eq key_mod "Bottom") (setvar "cmljust" 2))

)

)

(setq scale_ml (getdist (strcat "\nEntrez l'échelle de la multiligne <" (rtos (getvar "cmlscale")) ">: ")))

(if scale_ml (setvar "cmlscale" scale_ml))

(setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))

(setvar "osmode" 0)

(setvar "cmdecho" 0)

(repeat (sslength jspl)

(setq

typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr))))))

name_layer (cdr (assoc 8 dxf_ent))

)

(cond

((eq typent "LWPOLYLINE")

(setq

closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)

lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))

l_bub (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))

)

)

((eq typent "POLYLINE")

(setq

closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)

e_next (entnext ent)

)

(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))

(if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))

(setq

lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst)

l_bub (cons (cdr (assoc 42 dxf_next)) l_bub)

)

)

(setq e_next (entnext e_next))

)

(setq

lst (reverse lst)

l_bub (reverse l_bub)

)

)

)

(cond

((and lst (apply 'and (mapcar 'zerop l_bub)))

(setvar "clayer" name_layer)

(command "_.mline")

(foreach n lst (command n))

(if (not (zerop closed)) (command "_close") (command ""))

(entdel ent)

)

(T (princ "\nLes polylignes comportant des arrondis n'ont pas été traitées!"))

)

(setq nbr (1+ nbr) lst nil l_bub nil)

)

(setvar "clayer" oldlayer)

(setvar "osmode" oldosm)

(setvar "cmdecho" 1)

)

(T (princ "\nSélection vide"))

)

(prin1)

)

[(gile)]

Il manque une parenthèse ouvrante au début du code.

Ça vient probablement de là si tu as directement collé ce code en ligne de commande.

[philous2]

Il manque une parenthèse ouvrante au début du code.

Ça vient probablement de là si tu as directement collé ce code en ligne de commande.

J'ai refait un copie-colle du code effectivement j'avais oublié cette parenthèse mais sur mon original c'est bon

[(gile)]

Chez moi ça fonctionne.

 

Comment charges-tu le LISP ?

Comment l'appelles-tu ?

En l'état, on ne peut l'appeler en entrant directement po2ml en ligne de commande, il faut faire : (po2ml)

Si tu veux pouvoir l'appeler comme une commande, il faut remplacer (defun po2ml ...) par (defun c:po2ml ...)

[lecrabe]

Hello

 

Attention la routine PO2ML vient de notre inestimable "Ardechois Coeur Fidele", donc "Respect" !

 

lecrabe

[philous2]

Chez moi ça fonctionne.

 

Comment charges-tu le LISP ?

Comment l'appelles-tu ?

En l'état, on ne peut l'appeler en entrant directement po2ml en ligne de commande, il faut faire : (po2ml)

Si tu veux pouvoir l'appeler comme une commande, il faut remplacer (defun po2ml ...) par (defun c:po2ml ...)

Merci gile je n'avais vu qu'il manquait le "C:" devant "po2ml", c'est là que l'on reconnait les pros

Nickel ça fonctionne super, cette macro va m'etre tres utile demain au boulot.

Encore merci gile

[speedy]

Bonjour à toutes et à tous

Cétait pondu par Bruno " http://forums.autodesk.com/t5/AutoCAD-Francais/Transformation-de-Polyligne-en-Multiligne/td-p/2369336

effectivement respect, que ce cache derrière le smiley....

 

Michel

[bonuscad]

Un lisp de 6ans déjà ... étonnant qu'il n'y ait pas eu d'autres propositions depuis plus au goût du jour.

 

En tout cas, pour éviter le problème de smiley vous pouvez le prendre directement là:

http://bonuscad.perso.sfr.fr/bonuscad/po2ml.lsp

[philous2]

Bonjour à toutes et à tous

Cétait pondu par Bruno " http://forums.autodesk.com/t5/AutoCAD-Francais/Transformation-de-Polyligne-en-Multiligne/td-p/2369336

effectivement respect, que ce cache derrière le smiley....

Michel

Effectivement bon lisp par contre je n'ai pas pu l'utiliser vraiment à cause d'un hic de taille il ne tient pas compte des polylignes "cercle" et dans mon cas j'ai la plupar tdut emps un mélange de segment et d'arc de cercle ni considéré par cette macro.

Y-a-t-il un moyen de modifier ce super lisp pour être totalement parfait !

[zebulon_]

Le hic de taille ne provient pas du lisp. Le fait est que les multilignes ne peuvent contenir que des segments droits alors que les polylignes peuvent avoir des segments courbes.

D'où l'impossibilité de convertir à 100% des polylignes en multilignes. Enfin, à ma connaissance et jusqu'à présent.

 

Amicalement

Vincent

[bonuscad]

Comme le dit zebulon les multilignes ne peuvent être constituées que de segments droit.

 

Après il est possible de simuler un arc en multiligne par succession de points assez rapprochés.

 

Voici par exemple ce qui pourrait être fait pour dessiner un arc de multiligne par 3 points, mais je n'ai pas le temps pour intégrer ce concept dans le code proposé précédemment.

((lambda ( / p1 p2 ll pt_m px1 px2 key p3 px3 px4 pt_cen rad inc ang nm lst_pt pa1 pa2)
 (initget 9)
 (setq p1 (getpoint "\nPremier point: "))
 (initget 9)
 (setq p2 (getpoint p1 "\nPoint suivant: "))
 (setq
   ll (list p1 p2)
   pt_m
   (mapcar
     '/
     (list
       (apply '+ (mapcar 'car ll))
       (apply '+ (mapcar 'cadr ll))
       (apply '+ (mapcar 'caddr ll))
     )
     '(2.0 2.0 2.0)
   )
   px1 (polar pt_m (+ (angle p1 p2) (* pi 0.5)) (distance p1 p2))
   px2 (polar pt_m (- (angle p1 p2) (* pi 0.5)) (distance p1 p2))
 )
 (princ "\nDernier point: ")
 (while (and (setq key (grread T 4 0)) (/= (car key) 3))
   (cond
     ((eq (car key) 5)
       (redraw)
       (setq
         p3 (cadr key)
         ll (list p1 p3)
         pt_m
         (mapcar
           '/
           (list
             (apply '+ (mapcar 'car ll))
             (apply '+ (mapcar 'cadr ll))
             (apply '+ (mapcar 'caddr ll))
           )
           '(2.0 2.0 2.0)
         )
         px3 (polar pt_m (+ (angle p1 p3) (* pi 0.5)) (distance p1 p3))
         px4 (polar pt_m (- (angle p1 p3) (* pi 0.5)) (distance p1 p3))
         pt_cen (inters px1 px2 px3 px4 nil)
       )
       (cond
         (pt_cen
           (setq 
             rad (distance pt_cen p3)
             inc (angle pt_cen p1)
             ang (+ (* 2.0 pi) (angle pt_cen p3))
             nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
             lst_pt '()
           )
           (repeat nm
             (setq
               pa1 (polar pt_cen inc rad)
               inc (+ inc (/ (* pi 2.0) 36.0))
               pa2 (polar pt_cen inc rad)
               lst_pt (append lst_pt (list pa1 pa2))
             )
           )
           (setq lst_pt (append lst_pt (list (if pa2 pa2 p1) p3)))
           (grvecs lst_pt)
         )
       )
     )
   )
 )
 (cond
   (lst_pt
     (command "_.mline")
     (foreach n lst_pt (command "_none" n))
     (command "")
   )
 )
 (prin1)
))

[philous2]

Comme le dit zebulon les multilignes ne peuvent être constituées que de segments droit.

 

Après il est possible de simuler un arc en multiligne par succession de points assez rapprochés.

 

Voici par exemple ce qui pourrait être fait pour dessiner un arc de multiligne par 3 points, mais je n'ai pas le temps pour intégrer ce concept dans le code proposé précédemment.

((lambda ( / p1 p2 ll pt_m px1 px2 key p3 px3 px4 pt_cen rad inc ang nm lst_pt pa1 pa2)
 (initget 9)
 (setq p1 (getpoint "\nPremier point: "))
 (initget 9)
 (setq p2 (getpoint p1 "\nPoint suivant: "))
 (setq
   ll (list p1 p2)
   pt_m
   (mapcar
     '/
     (list
       (apply '+ (mapcar 'car ll))
       (apply '+ (mapcar 'cadr ll))
       (apply '+ (mapcar 'caddr ll))
     )
     '(2.0 2.0 2.0)
   )
   px1 (polar pt_m (+ (angle p1 p2) (* pi 0.5)) (distance p1 p2))
   px2 (polar pt_m (- (angle p1 p2) (* pi 0.5)) (distance p1 p2))
 )
 (princ "\nDernier point: ")
 (while (and (setq key (grread T 4 0)) (/= (car key) 3))
   (cond
     ((eq (car key) 5)
       (redraw)
       (setq
         p3 (cadr key)
         ll (list p1 p3)
         pt_m
         (mapcar
           '/
           (list
             (apply '+ (mapcar 'car ll))
             (apply '+ (mapcar 'cadr ll))
             (apply '+ (mapcar 'caddr ll))
           )
           '(2.0 2.0 2.0)
         )
         px3 (polar pt_m (+ (angle p1 p3) (* pi 0.5)) (distance p1 p3))
         px4 (polar pt_m (- (angle p1 p3) (* pi 0.5)) (distance p1 p3))
         pt_cen (inters px1 px2 px3 px4 nil)
       )
       (cond
         (pt_cen
           (setq 
             rad (distance pt_cen p3)
             inc (angle pt_cen p1)
             ang (+ (* 2.0 pi) (angle pt_cen p3))
             nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
             lst_pt '()
           )
           (repeat nm
             (setq
               pa1 (polar pt_cen inc rad)
               inc (+ inc (/ (* pi 2.0) 36.0))
               pa2 (polar pt_cen inc rad)
               lst_pt (append lst_pt (list pa1 pa2))
             )
           )
           (setq lst_pt (append lst_pt (list (if pa2 pa2 p1) p3)))
           (grvecs lst_pt)
         )
       )
     )
   )
 )
 (cond
   (lst_pt
     (command "_.mline")
     (foreach n lst_pt (command "_none" n))
     (command "")
   )
 )
 (prin1)
))

 

Bjr Bruno, je te remercie beaucoup de ta réponse.

Je connaissais vaguement les muiltilignes mais je ne mettais jamais posé la question comment cela fonctionnait, je comprend mieux dorénavant merci zébulon.

Mes connaissances en matière de programation étant limité je crains que ton travail Bruno ne me serve, mais bon boulot on voit les pros du lisp :D .

Mais peut-être comme tu le disais dasn une réponse précédente qu'il y a aura d'autres propositions sur le sujet.

Perosnnellememnt je trouvais intéressant le prinicipe des multilignes en matière de cartographie routière.

Encore merci Bruno pour ton boulot superbe.

Phil

[bonuscad]

En faisant de l'assemblage de routines existantes, j'ai rapidement monté ceci.

Je l'ai testé que très brièvement...

Cela pourra traiter des LWPOLYLINE,POLYLINE(2D),LINE,CIRCLE et ARC d'un jeu de sélection.

 

(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
 (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
 (while (cadr ls)
   (if (zerop (car lb))
     (setq l_new (append l_new (list (car ls))))
     (progn
       (setq
         rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
         a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
       )
       (if (< a 0.0) (setq a (- (* 2.0 pi) a)))
       (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
         (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
         (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
       )
     )
   )
   (setq ls (cdr ls) lb (cdr lb))
 )
 (append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
 (setq
   inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
   ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
   nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
 )
 (repeat nm
   (setq
     p1 (polar pt_cen inc rad)
     inc (+ inc (/ (* pi 2.0) 36.0))
     lst (append lst (list p1))
   )
 )
 (setq
   p2 (polar pt_cen ang rad)
   lst (append lst (list p2))
 )
 (if (< sens 0.0) (reverse lst) lst)
)
(defun c:po2ml ( / jspl nbr ent dxf_ent typent name_layer closed lst l_bulg e_next dxf_next oldlayer oldosm key_mod scale_ml)
 (princ "\nChoix des polylignes à transformer en multilignes: ")
 (setq
   jspl (ssget '((0 . "*POLYLINE,LINE,CIRCLE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 124) (-4 . "NOT>")))
   nbr 0
 )
 (cond
   (jspl
     (initget "Dessus Nulle dEssous _Top Zero Bottom")
     (setq key_mod
       (getkword
         (strcat
           "\nEntrez le type de justification [Dessus/Nulle/dEssous] <"
           (cond
             ((eq (getvar "cmljust") 0)
               "Dessus"
             )
             ((eq (getvar "cmljust") 1)
               "Nulle"
             )
             ((eq (getvar "cmljust") 2)
               "dEssous"
             )
           )
           ">: "
         )
       )
     )
     (if key_mod
       (cond
         ((eq key_mod "Top") (setvar "cmljust" 0))
         ((eq key_mod "Zero") (setvar "cmljust" 1))
         ((eq key_mod "Bottom") (setvar "cmljust" 2))
       )
     )
     (setq scale_ml (getdist (strcat "\nEntrez l'échelle de la multiligne <" (rtos (getvar "cmlscale")) ">: ")))
     (if scale_ml (setvar "cmlscale" scale_ml))
     (setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     (command "_.ucs" "_world")
     (repeat (sslength jspl)
       (setq
         typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr))))))
         name_layer (cdr (assoc 8 dxf_ent))
       )
       (cond
         ((eq typent "LWPOLYLINE")
           (setq
             closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
             lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
             l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
             lst (def_bulg_pl lst l_bulg closed)
           )
         )
         ((eq typent "POLYLINE")
           (setq
             closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
             e_next (entnext ent)
           )
           (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
             (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
               (setq
                 lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst)
                 l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg)
               )
             )
             (setq e_next (entnext e_next))
           )
           (setq
             lst (reverse lst)
             l_bulg (reverse l_bulg)
             lst (def_bulg_pl lst l_bulg closed)
           )
         )
         ((eq typent "LINE")
           (setq
             lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1))
             closed 0
           )
         )
         ((eq typent "CIRCLE")
           (setq
             lst
               (bulge_pts
                 (trans (cdr (assoc 10 dxf_ent)) ent 1)
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) 0.0 (cdr (assoc 40 dxf_ent)))
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent)))
                 (cdr (assoc 40 dxf_ent))
                 1
               )
             lst (append lst (list (car lst)))
             closed 1
           )
         )
         ((eq typent "ARC")
           (setq
             lst
               (bulge_pts
                 (trans (cdr (assoc 10 dxf_ent)) ent 1)
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent)))
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent)))
                 (cdr (assoc 40 dxf_ent))
                 1
               )
             closed 0
           )
         )
       )
       (cond
         (lst
           (setvar "clayer" name_layer)
           (command "_.mline")
           (foreach n lst (command n))
           (if (not (zerop closed)) (command "_close") (command ""))
           (entdel ent)
         )
       )
       (setq nbr (1+ nbr) lst nil l_bulg nil)
     )
     (command "_.ucs" "_previous")
     (setvar "clayer" oldlayer)
     (setvar "osmode" oldosm)
     (setvar "cmdecho" 1)
   )
   (T (princ "\nSélection vide"))
 )
 (prin1)
)

[philous2]

En faisant de l'assemblage de routines existantes, j'ai rapidement monté ceci.

Je l'ai testé que très brièvement...

Cela pourra traiter des LWPOLYLINE,POLYLINE(2D),LINE,CIRCLE et ARC d'un jeu de sélection.

 

(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
 (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
 (while (cadr ls)
   (if (zerop (car lb))
     (setq l_new (append l_new (list (car ls))))
     (progn
       (setq
         rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
         a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
       )
       (if (< a 0.0) (setq a (- (* 2.0 pi) a)))
       (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
         (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
         (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
       )
     )
   )
   (setq ls (cdr ls) lb (cdr lb))
 )
 (append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
 (setq
   inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
   ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
   nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
 )
 (repeat nm
   (setq
     p1 (polar pt_cen inc rad)
     inc (+ inc (/ (* pi 2.0) 36.0))
     lst (append lst (list p1))
   )
 )
 (setq
   p2 (polar pt_cen ang rad)
   lst (append lst (list p2))
 )
 (if (< sens 0.0) (reverse lst) lst)
)
(defun c:po2ml ( / jspl nbr ent dxf_ent typent name_layer closed lst l_bulg e_next dxf_next oldlayer oldosm key_mod scale_ml)
 (princ "\nChoix des polylignes à transformer en multilignes: ")
 (setq
   jspl (ssget '((0 . "*POLYLINE,LINE,CIRCLE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 124) (-4 . "NOT>")))
   nbr 0
 )
 (cond
   (jspl
     (initget "Dessus Nulle dEssous _Top Zero Bottom")
     (setq key_mod
       (getkword
         (strcat
           "\nEntrez le type de justification [Dessus/Nulle/dEssous] <"
           (cond
             ((eq (getvar "cmljust") 0)
               "Dessus"
             )
             ((eq (getvar "cmljust") 1)
               "Nulle"
             )
             ((eq (getvar "cmljust") 2)
               "dEssous"
             )
           )
           ">: "
         )
       )
     )
     (if key_mod
       (cond
         ((eq key_mod "Top") (setvar "cmljust" 0))
         ((eq key_mod "Zero") (setvar "cmljust" 1))
         ((eq key_mod "Bottom") (setvar "cmljust" 2))
       )
     )
     (setq scale_ml (getdist (strcat "\nEntrez l'échelle de la multiligne <" (rtos (getvar "cmlscale")) ">: ")))
     (if scale_ml (setvar "cmlscale" scale_ml))
     (setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     (command "_.ucs" "_world")
     (repeat (sslength jspl)
       (setq
         typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr))))))
         name_layer (cdr (assoc 8 dxf_ent))
       )
       (cond
         ((eq typent "LWPOLYLINE")
           (setq
             closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
             lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
             l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
             lst (def_bulg_pl lst l_bulg closed)
           )
         )
         ((eq typent "POLYLINE")
           (setq
             closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
             e_next (entnext ent)
           )
           (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
             (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
               (setq
                 lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst)
                 l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg)
               )
             )
             (setq e_next (entnext e_next))
           )
           (setq
             lst (reverse lst)
             l_bulg (reverse l_bulg)
             lst (def_bulg_pl lst l_bulg closed)
           )
         )
         ((eq typent "LINE")
           (setq
             lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1))
             closed 0
           )
         )
         ((eq typent "CIRCLE")
           (setq
             lst
               (bulge_pts
                 (trans (cdr (assoc 10 dxf_ent)) ent 1)
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) 0.0 (cdr (assoc 40 dxf_ent)))
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent)))
                 (cdr (assoc 40 dxf_ent))
                 1
               )
             lst (append lst (list (car lst)))
             closed 1
           )
         )
         ((eq typent "ARC")
           (setq
             lst
               (bulge_pts
                 (trans (cdr (assoc 10 dxf_ent)) ent 1)
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent)))
                 (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent)))
                 (cdr (assoc 40 dxf_ent))
                 1
               )
             closed 0
           )
         )
       )
       (cond
         (lst
           (setvar "clayer" name_layer)
           (command "_.mline")
           (foreach n lst (command n))
           (if (not (zerop closed)) (command "_close") (command ""))
           (entdel ent)
         )
       )
       (setq nbr (1+ nbr) lst nil l_bulg nil)
     )
     (command "_.ucs" "_previous")
     (setvar "clayer" oldlayer)
     (setvar "osmode" oldosm)
     (setvar "cmdecho" 1)
   )
   (T (princ "\nSélection vide"))
 )
 (prin1)
)

Bonsoir Bruno,

Je viens de lire ton post, super sympa.

Je l'ai enregistré et chargé vite fait sous le nom "def_bulg_pl", j'ai ça comme message d'erreur et le code j'ai pris aussi le même que le nom.

J'ai certainement du faire une mauvaise manip car si ça marche chez toi.

Encore vraiment merci

Phil

 

Commande: _appload def_bulg_pl.LSP correctement chargé(s)

Commande: ; erreur: no function definition: LS

Commande:

Commande: def_bulg_pl

Commande inconnue "DEF_BULG_PL".

[-Olivier-]

Bonjour Philous2,

Le nom de la commande est toujours po2ml. DEF_BULG_PL n'est qu'une sous-routine utilisée par la routine principale.

Les commandes utilisables en ligne de commande commence par c: (voir réponse #4).

Félicitation à Bruno, la commande fonctinne parfaitement.

Olivier

[JMBZ38]

Nickel ce Lisp, il correspond pratiquement à ce que je cherchais. Merci aux "artistes" pour le développement !

 

Je cherche une petite variante :

 

Les polylignes à transformer ont toutes une largeur (LA de la commande pedit). Le but serait de transformer les polylignes sélectionnées en multiligne en leur appliquant un paramètre d'échelle correspondant à leur LArgeur respective.

 

Une idée ??

 

Merci.

[bonuscad]

Je cherche une petite variante :

 

En ramenant le code aux simples LWPOLYLINE (seules celle-ci peuvent avoir une largeur constante, code DXF 43), ça donnerait ceci (je ne me suis pas cassé la tête et fait au plus rapide):

 

(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
 (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
 (while (cadr ls)
   (if (zerop (car lb))
     (setq l_new (append l_new (list (car ls))))
     (progn
       (setq
         rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
         a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
       )
       (if (< a 0.0) (setq a (- (* 2.0 pi) a)))
       (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
         (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
         (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
       )
     )
   )
   (setq ls (cdr ls) lb (cdr lb))
 )
 (append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
 (setq
   inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
   ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
   nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
 )
 (repeat nm
   (setq
     p1 (polar pt_cen inc rad)
     inc (+ inc (/ (* pi 2.0) 36.0))
     lst (append lst (list p1))
   )
 )
 (setq
   p2 (polar pt_cen ang rad)
   lst (append lst (list p2))
 )
 (if (< sens 0.0) (reverse lst) lst)
)
(defun c:po2ml ( / jspl nbr ent dxf_ent typent name_layer closed lst l_bulg oldlayer oldosm)
 (princ "\nChoix des polylignes à transformer en multilignes: ")
 (setq
   jspl (ssget '((0 . "LWPOLYLINE")))
   nbr 0
 )
 (cond
   (jspl
     (setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))
     (setvar "osmode" 0)
     (setvar "cmdecho" 0)
     (setvar "cmljust" 1)
     (command "_.ucs" "_world")
     (repeat (sslength jspl)
       (setq
         typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr))))))
         name_layer (cdr (assoc 8 dxf_ent))
       )
       (setq
         closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
         lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
         l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
         lst (def_bulg_pl lst l_bulg closed)
       )
       (setvar "cmlscale" (cdr (assoc 43 dxf_ent)))
       (cond
         (lst
           (setvar "clayer" name_layer)
           (command "_.mline")
           (foreach n lst (command n))
           (if (not (zerop closed)) (command "_close") (command ""))
           (entdel ent)
         )
       )
       (setq nbr (1+ nbr) lst nil l_bulg nil)
     )
     (command "_.ucs" "_previous")
     (setvar "clayer" oldlayer)
     (setvar "osmode" oldosm)
     (setvar "cmdecho" 1)
   )
   (T (princ "\nSélection vide"))
 )
 (prin1)
)

[lecrabe]

Hello Bruno

 

Merci pour cette version "adaptee" de PO2ML !

 

Avec la routine CMLS de Gilles (pour changer de Style des Multi-Lignes)

cela forme un couple fort util !

 

Tiens voila une idee interessante : Bruno + Gilles = un couple "detonant" sur AutoCAD !

 

lecrabe

 

PS: Routine PO2ML testee sur AutoCAD 2013 32 bits sous Win XP Pro SP3

[JMBZ38]

Super, merci pour y avoir consacré du temps.

 

Cependant il se passe des choses troublantes :

 

Après une sélection de plusieurs polylignes de largeurs différentes le lisp fonctionne, mais parfois sur d'autres polylignes j'ai ce message d'erreur :

 

 

; erreur: paramètre de la variable AutoCAD rejeté: "cmlscale" nil

 

 

??

 

ci-joint fichier avec les 2 cas de figures.

[lecrabe]

Hello

 

ATTENTION : la notion d'Arc n'existe pas dans une Multi-Ligne !

 

La routine de Bruno discretise les arcs en segments,

mais je pense que dans certains cas elle n'y arrive pas !

Mais SEUL Bruno pourra confirmer ?

 

Mais en fait ton probleme est SUREMENT PLUTOT le suivant :

tu n'as pas le MEME facteur globale de largeur sur les Polylignes de droite !

 

En mettant Largeur Globale = 0.02 sur TOUTES les Polylignes de droite,

la routine PO2ML de Bruno est OK !!

 

lecrabe

[JMBZ38]

C'était bien une question de largeur globale qui n'était pas renseignée.

 

Merci à tous.

[Ramses]

Bonjour à tous, et merci pour ce lisp tout simplement fabuleux.

Est-il possible au lieu d'avoir les multilignes comme ceci:

 

http://img15.hostingpics.net/thumbs/mini_1139784501.jpg

 

d'avoir des multilignes avec entrelacs comme ceci c'est à dire une fois en haut une fois en bas.

 

http://img15.hostingpics.net/thumbs/mini_6769368102.jpg

 

J'ignore si les multilignes d'AutoCAD acceptent cette possibilité.

Merci

[Ramses]

Bonjour,

Oui les multilgnes supportent bien cela avec MLEDIT "croix fermée".

Mais est-il possible d'automatiser celà ? :)

Merci

[GEGEMATIC]

salut,

c'est tout a fait possible, mais ya un peu de boulot je pense.

 

1 : il te faut créer le jeux de sélection des multi lignes à traiter

 

2 : parcourir ton jeu de sélection , et sélectionner les multilignes qui coupent ta multiligne,

par exemple en utilisant _fastsel, sélection par trajet

 

2 : tu obtiens donc un nouveau jeux de sélection : les multilignes qui coupent ta multiligne

 

3 : tu trouve les points de coupure avec la méthode IntersectWith :

 

RetVal = object.IntersectWith(IntersectObject, ExtendOption) 

;;exemple d'utilisation en lisp :
(setq e1 (vlax-ename->vla-object e1))
 (setq e2 (vlax-ename->vla-object e2))
 (setq res (vla-IntersectWith e1 e2 acExtendNone))

 

4: il te faut classer les point d'intersection trouvé par ordre de parcours le long de ta multiligne : Pour cela utilise les fonction curve, notamment celle ci :

vlax-curve-getDistAtPoint 

Returns the length of the curve's segment between the curve's start point and the specified point 

(vlax-curve-getDistAtPoint curve-obj point)

 

5: ensuite tu parcours ces intersection dans l'ordre et tu alterne l'ordre de sélection des multilignes pour l'opération croix fermées

il te faut également émuler un entsel avec un liste composée de ton point d'intersection et de chacune des multilignes :

 

(setq sel (list maMultiligne monInters))
(setq sel2 (list maMultiligneCoupee1 monInters))
(command "_mledit" "CF" sel sel2)

 

Voilà, en gros, c'est faisable, mais ya du boulot.

 

Gérald

[Ramses]

Merci Gérald pour cette réponse,

 

cela fait un sacré temps que je n'ai pas touché au lisp, et déjà je ne maîtrise pas.

C'est vrai, il y a du travail, surtout qu'il n'y a pas une seule multiligne qui est coupée par les autres, mais plutot, des mutilignes qui se coupent les unes par rapport aux autres.

 

Merci beaucoup pour la démarche

A très bientôt

Yusuf