Diviser/couper et mesurer/couper

[(gile)]

Deux petites routines pour tronçonner des objets curvilignes (arc, cercle, ellipse, ligne, polylignes, et spline) soit en un nombre spécifié de tronçons : DivCut, soit en des tronçons d'une longueur spécifiée : MesDiv

 

EDIT : NOUVELLE VERSION, l'ancienne ne fonctionnait pas avec les polylignes 2D et 3D, ni avec les polylignes fermées

 

;; DIVCUT
;; Coupe l'objet sélectionné en le nombre spécifié de tronçons égaux

(defun c:divcut	(/ ent end div len elst)
 (vl-load-com)
 (if
   (and
     (setq ent (car (entsel)))
     (not (vl-catch-all-error-p
     (setq end
	    (vl-catch-all-apply 'vlax-curve-getEndParam (list ent))
     )
   )
     )
     (princ
(strcat	"\nLongueur de l'objet : "
	(rtos (setq len (vlax-curve-getDistAtParam ent end)))
)
     )
     (setq div (getint "\nNombre de divisions: "))
     (      (setq len (/ len div))
   )
    (progn
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (repeat (1- div)
 (setq
   ent
    (cadr
      (CutCurveAtPoint ent (vlax-curve-getPointAtDist ent len))
    )
 )
      )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (princ "\nEntité non valide")
 )
 (princ)
)

;; MESCUT
;; Coupe l'objet sélectionné en tronçons de la longueur spécifiée

(defun c:mescut	(/ ent end tot len div elst)
 (vl-load-com)
 (if
   (and
     (setq ent (car (entsel)))
     (not (vl-catch-all-error-p
     (setq end
	    (vl-catch-all-apply 'vlax-curve-getEndParam (list ent))
     )
   )
     )
     (princ
(strcat	"\nLongueur de l'objet : "
	(rtos (setq tot (vlax-curve-getDistAtParam ent end)))
)
     )
     (setq len (getdist "\nLongueur du segment: "))
     (      (setq div (fix (/ tot len)))
   )
    (progn
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (repeat div
 (setq
   ent
    (cadr
      (CutCurveAtPoint ent (vlax-curve-getPointAtDist ent len))
    )
 )
      )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (princ "\nEntité non valide")
 )
 (princ)
) 

;; Coupe un objet curviligne au point spécifié
;;
;; Arguments
;; ent : l'objet à couper (ename ou vla-object)
;; pt : le point de coupure (coordonnées WCS)
;;
;; Retour
;; une liste des deux objets créés (ename ou vla-object)

(defun CutCurveAtPoint (ent pt / vl lst cl start end ec os)
 (vl-load-com)
 (and (= (type ent) 'VLA-OBJECT)
      (setq ent	(vlax-vla-object->ename ent)
     vl	T
      )
 )
 (cond
   ((equal pt (vlax-curve-getEndPoint ent) 1e-9)
    (setq lst (list ent nil))
   )
   ((equal pt (vlax-curve-getStartPoint ent) 1e-9)
    (setq lst (list nil ent))
   )
   ((null (vlax-curve-getParamAtPoint ent pt))
    (setq lst (list ent nil))
   )
   (T
    (setq start (trans (vlax-curve-getStartPoint ent) 0 1)
   end	 (trans (vlax-curve-getEndPoint ent) 0 1)
   ec	 (getvar "cmdecho")
   os	 (getvar "osmode")
    )
    (setvar "cmdecho" 0)
    (setvar "osmode" 0)
    (if (and (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
      (= 1 (logand 1 (cdr (assoc 70 (entget ent)))))
 )
      (progn
 (command "_.break" ent (trans pt 0 1) "@")
 (setq cl (entlast))
      )
      (progn
 (if (= "POLYLINE" (cdr (assoc 0 (entget ent))))
   (progn
     (entmake (entget ent))
     (setq vx (entnext ent))
     (while (= "VERTEX" (cdr (assoc 0 (entget vx))))
       (entmake (entget vx))
       (setq vx (entnext vx))
     )
     (entmake '((0 . "SEQEND")))
     (setq cl (entlast)
	   po T
     )
   )
   (setq cl (entmakex (entget ent)))
 )
 (command "_.break" ent (trans pt 0 1) end)
 (and po (setq ent (entlast)))
 (command "_.break" cl start (trans pt 0 1))
 (and po (setq cl (entlast)))
      )
    )
    (setvar "cmdecho" ec)
    (setvar "osmode" os)
    (setq lst (list ent cl))
   )
 )
 (if vl
   (mapcar '(lambda (x)
       (if x
	 (vlax-ename->vla-object x)
       )
     )
    lst
   )
   lst
 )
) 

 

[Edité le 17/9/2007 par (gile)]

[(gile)]

J'ai modifié le code ci-dessus, il y avait des dysfonctionnements avec les polylignes 2D/3D et les polylignes fermées (tous types).

[lili2006]

Bonsoir à toutes et tous,

 

(gile), tu ne t'arretes jamais ??

 

Je n'y comprend toujourd rien en lisp (mais j'ai vu que des petits cours m'attendais,...), mais ce que je constate c'est que tes routines sont pointus en fonctionnement, et forcément, il faut une bonne connaissance en mathématiques (et en langage Lisp, ça va de soi !), contrairement à ce que tu écrivais sur un autre post,....

[(gile)]

Salut,

 

(gile), tu ne t'arretes jamais ??

 

Non !

 

En fait, ces dernières routines sont issues de trucs que je trainais, c'est nicoping28 avec ses problèmes d'ellipses et de machines à commandes numériques qui ne veulent que des polylignes (arcs de cercles uniquement) qui m'ont poussé à finaliser tout ça.

[lecrabe]

 

Hello

 

Encore Merci Gilles

 

Et si jamais un jour il n'y a plus de Lisp et V-Lisp dans AutoCAD !

 

Que vas tu de venir ?? :)

 

Pas de panique, c'est de l'humour !!! :P

 

Le Decapode

 

[(gile)]

Et si jamais un jour il n'y a plus de Lisp et V-Lisp dans AutoCAD !

 

Que vas tu de venir ??

 

Un militant pour le boycott international des nouvelles versions qui ne supporteraient plus AutoLISP / VisualLISP ;)

[lesourd2]

Salut

 

Un peu dans le meme genre, je cherche un LISP qui me permetrait de couper une polyligne aux endroits selectionnés et que celle-ci reste une seule entité.

Actuellement en coupant une polyligne en deux (par ex) j'en obtiens donc deux et je n'arrive pas a fusionner les morceaux pour n'en faie qu'une.

 

Par avance MERCI

 

@+

[(gile)]

Un peu dans le meme genre, je cherche un LISP qui me permetrait de couper une polyligne aux endroits selectionnés et que celle-ci reste une seule entité.

:exclam: :P :casstet:

 

Comprends pas...

[lesourd2]

Re

 

Pour etre plus clair; tracer une polyligne, la continuer sans obligation de repartir du dernier point et qu'elle reste une seule polyligne.En temps normal si tu fais cela tu te retrouves avec 2"morceaux" de polyligne.

 

@+

[(gile)]

On ne peut pas faire de polylignes (ni de lignes, arcs, splines...) discontinues.