scinder polyligne

[pascal19]

Bonjour

 

Je cherche à scinder une polyligne en segments de polylignes(pas des lignes)et j'ai fait cette routine avec l'aide de l'historique du forum:

 

(defun C:dpol ()

 (setvar "cmdecho" 0)
 (setq pld (entsel "\nSélectionnez une polyligne: "))
 (setq grh (massoc 10 (entget (car pld))))

 (setq lst1 (cdr grh))

 (setq pt (car lst1))

 (while lst1
   (progn (command "coupure" pld "1" pt pt)
   (setq lst1 (cdr lst1))
   (setq pt (car lst1))
   (setq pld entlast)
   )
 )
)

(defun massoc (key alst / ret)
 (foreach p alst
   (if	(= (car p) key)
     (setq ret (cons (cdr p) ret))
   )
 )
 (reverse ret)
)

 

Mais ça ne marche pas car la commande coupure m'enlève l'entité de départ (pld) , du coup, ça fonctionne que sur le premier sommet. J'ai essayé avec entlast mais comme "coupure" crée 2 entités , ce n'est jamais la bonne...

[bonuscad]

Bonjour,

 

Je suis tombé il y a pas longtemps sur un forum US sur une solution sympa et performante ->BreakPoly

[pascal19]

OK merci

 

J'ai donc récupéré ça:

 

(defun C:BRP (/ *error* el en end head i ss start tail)
 (or acDoc
     (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
 )
 (vla-startundomark acDoc)

 (defun *error* (m)
   (and m
 (not (wcmatch (strcase m) "*CANCEL*,*QUIT*,*EXIT*"))
 (princ (strcat "\nError: " m))
   )
   (vla-endundomark acDoc)
   (princ)
 )

 (if
   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (repeat (setq i (sslength ss))
      (setq en	   (ssname ss (setq i (1- i)))
     el	   (entget en)
     head  (vl-remove-if-not
	     '(lambda (x)
		(vl-position
		  (car x)
		  '(0 100 67 410 8 62 6 370 43 38 39)
		)
	      )
	     el
	   )
     head  (append head
		   (list '(90 . 2)
			 (cons 70 (logand (cdr (assoc 70 el)) 128))
		   )
	   )
     tail  (member (assoc 10 el) el)
     start (if (= (logand (cdr (assoc 70 el)) 1) 1)
	     (car tail)
	   )
     end   (append '((40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0))
		   (list (assoc 210 el))
	   )
      )
      (repeat (1- (cdr (assoc 90 el)))
 (entmake
   (append head
	   (mapcar '(lambda (x) (nth x tail)) '(0 1 2 3 4 5))
	   end
   )
 )
 (setq tail (member (assoc 10 (cdr tail)) (cdr tail)))
      )
      (if start
 (entmake
   (append head
	   (mapcar '(lambda (x) (nth x tail)) '(0 1 2 3 4))
	   (list start)
	   end
   )
 )
      )
      (entdel en)
    )
 )
 (vla-endundomark acDoc)
 (princ)
)

 

C'est preque parfait,il faudrait juste conserver l'échelle de type de ligne de la polyligne source...

[bonuscad]

C'est preque parfait,il faudrait juste conserver l'échelle de type de ligne de la polyligne source...

 

En modifiant la liste des codes DXF à conserver, ça devrait le faire (code 48 en plus)

'(0 100 67 410 8 62 6 370 48 43 38 39)

[-Olivier-]

Bonjour Pascal19,

En remplaçant la ligne

 

                          '(0 100 67 410 8 62 6 370 43 38 39)

 

par

 

                          '(0 100 67 410 8 62 6 370 43 38 39 48)

 

Olivier

PS : Grillé par Bonuscad :D

[pascal19]

merci à tous!