Aller au contenu

diviser une polyligne


mdsv31

Messages recommandés

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

 

Dessinateur Indépendant

Lien vers le commentaire
Partager sur d’autres sites

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)
)

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

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

Dessinateur Indépendant

Lien vers le commentaire
Partager sur d’autres sites

  • 11 ans après...

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.

Lien vers le commentaire
Partager sur d’autres sites

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)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité