diviser une polyligne

[mdsv31]

Bonjour,

 

Je voudrais creer un programme VBA qui me permettrai de pouvoir diviser une polyligne en X morceau

 

exemple :

 

je selectionne une polyligne

 

ensuite je dit a autocad que je veut la couper en 5

 

Ensuite autocad me remplace la polyligne existant par 5 petites polyligne

 

En esperant avoir ete claire

 

@+

 

MDSv31

 

[didier]

bonjour,

 

est ce un impératif de travailler en VBA ?

 

est il possible de chercher la solution en Lisp ?

 

dans l'attente, amicalement

[mdsv31]

Je comprend mieux le VBA, mais je suis aussi prenneur en LISP

 

@+

 

MDSV31

[bonuscad]

Salut,

 

Bon ben si t'es preneur en lisp, je peux te proposer ceci.

 

NB: Je n'ais pas fait de controle sur les polyligne de type maillage, dans ce cas la routine peut avorter. J'ai fais au plus court ;) Ca peut être amélioré ou pris sous un autre angle, comme tout programme. C'est relativement court, donc analysable plus facilement.

 

(defun c:div_pl ( / ent obj_vlax param_start param_end perim_obj res_track old_osmd l_pt lg)
(while (null (setq ent (entsel "\nChoix de la Ligne, Polyligne ou Spline: "))))
(cond
	((member (cdr (assoc 0 (entget (car ent)))) '("LINE" "LWPOLYLINE" "POLYLINE" "SPLINE"))
		(vl-load-com)
		(initget 7)
		(setq
			res_track (getint "\nNombre de division: ")
			obj_vlax (vlax-ename->vla-object (car ent))
			param_start (vlax-curve-getStartParam obj_vlax)
			param_end (vlax-curve-getEndParam obj_vlax)
			perim_obj (vlax-curve-getDistAtParam obj_vlax (+ param_start param_end))
			res_track (/ perim_obj res_track)
			l_pt '()
			lg 0.0
			old_osmd (getvar "osmode")
		)
		(while (< (+ lg res_track) perim_obj)
			(setq l_pt (cons (vlax-curve-getPointAtDist obj_vlax (setq lg (+ lg res_track))) l_pt))
		)
		(setvar "cmdecho" 0)
		(setvar "osmode" 0)
		(foreach n l_pt (command "_.break" n "_first" n n))
		(setvar "osmode" old_osmd)
		(setvar "cmdecho" 1)
	)
	(T (princ "\nN'est pas une Ligne, Polyligne ou Spline: "))
)
(prin1)
)

 

[mdsv31]

Bravo cela marche nickel

 

Mais c'est bien ce que je penser, il faut que je trouve de la documentation lisp car je ne comprend pas le code.

 

Je vais me pencher un peu plus dans le lisp quand j'aurai finis avec les api OpenOffice.org

 

Merci

 

@+

 

MDSV

[didier]

coucou

 

pas mieux,

 

bravo pour la réactivité.

 

ciao

[mdsv31]

Merci encore Bonuscad et Didier

 

De votre temps precieux temps

 

@+

 

MDSV31

[JMBZ38]

Bonjour à tous,

 

 

Je me permets d'extirper ce post pour une demande d'amélioration : La sélection de polyligne à diviser se fait manuellement et une par une, y aurait-il un moyen de faire une sélection multiple ?

 

Merci de prendre en considération ma demande et joyeuses fêtes à tous les membres du forum.

[bonuscad]

Bonjour à tous,

 

 

Je me permets d'extirper ce post pour une demande d'amélioration : La sélection de polyligne à diviser se fait manuellement et une par une, y aurait-il un moyen de faire une sélection multiple ?

 

Merci de prendre en considération ma demande et joyeuses fêtes à tous les membres du forum.

 

Bonjour,

 

J'ai essayé d'améliorer la fonction.

Celle ci est capable de traiter des lignes, arcs, polylignes optimisées, polylignes 2D et polylignes 3D.

Elle doit fonctionner dans ET depuis n'importe quel SCU. (un bémol avec des polylignes splinées ou la fonction peut avorté, un changement de zoom peut régler le problème...)

Les objets à traiter peuvent être filtrer auparavant avec FILTRER ou SELECTRAP par exemple, la fonction proposera alors de travailler avec ce jeu de sélection ou d'en créer un nouveau.

 

(vl-load-com)
(defun c:div_pl ( / js res AcDoc Space n ent obj_vlax nam_obj perim_obj res_track l_pt lg)
 (or
   (setq js (ssget "_I" '((-4 . "<AND") (0 . "*POLYLINE,LINE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>"))))
   (setq js (ssget "_P" '((-4 . "<AND") (0 . "*POLYLINE,LINE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>"))))
 )
 (cond
   (js
     (sssetfirst nil js)
     (initget "Existant Nouveau _Existent New")
     (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New")
       (progn
         (sssetfirst nil nil)
         (setq js (ssadd) js (ssget '((-4 . "<AND") (0 . "*POLYLINE,LINE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>"))))
       )
     )
   )
   (T
     (setq js (ssget '((-4 . "<AND") (0 . "*POLYLINE,LINE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>") (-4 . "AND>"))))
     (sssetfirst nil js)
   )
 )
 (cond
   (js
     (initget 7)
     (setq
       res (getint "\nNombre de division: ")
       AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space
       (if (= 1 (getvar "CVPORT"))
         (vla-get-PaperSpace AcDoc)
         (vla-get-ModelSpace AcDoc)
       )
     )
     (setvar "cmdecho" 0)
     (repeat (setq n (sslength js))
       (setq ent (ssname js (setq n (1- n))))
       (cond
         ((entget ent)
           (setq
             obj_vlax (vlax-ename->vla-object ent)
             nam_obj (vlax-get-property obj_vlax "ObjectName")
           )
         )
         (T (setq ent nil))
       )
       (cond
         (ent
           (setq
             perim_obj
             (if (vlax-property-available-p obj_vlax "Length")
               (vlax-get-property obj_vlax "Length")
               (vlax-get-property obj_vlax "ArcLength")
             )
             res_track (/ perim_obj res)
             l_pt '()
             lg 0.0
           )
           (while (and (< (+ lg res_track) perim_obj) (not (equal (+ lg res_track) perim_obj 1E-11)))
             (setq l_pt (cons (trans (vlax-curve-getPointAtDist obj_vlax (setq lg (+ lg res_track))) 0 1) l_pt))
           )
           (foreach n l_pt
             (if (member nam_obj '("AcDb2dPolyline" "AcDb3dPolyline"))
               (progn
                 (vl-cmdf "_.zoom" "_object" (car (nentselp n)) "")
                 (vl-cmdf "_.break" (nentselp n) "_first" "_none" n "_none" n)
                 (vl-cmdf "_.zoom" "_previous")
               )
               (vl-cmdf "_.break" (cons ent (list n)) "_first" "_none" n "_none" n)
             )
           )
         )
       )
     )
     (setvar "cmdecho" 1)
   )
 )
 (prin1)
)

[JMBZ38]

Merci BonusCAD, cette amélioration est tip-top ! L'année commence bien !

 

 

Meilleurs voeux à tous.