Polylignes 2D avec multi-largeur = GRRR

[lecrabe]

 

Hello

 

Objet: Polylignes 2D avec multi-largeur = GRRR

 

SVP je fais encore appel aux gentils / foldingues developpeurs de ce forum !

 

Je travaille en ce moment sur un dessin ou le concepteur a utilise "a fond" le changement de largeur (au niveau segment ou au niveau arc) dans des polylignes "de folie" !

 

Je peux bien sur traiter "A LA MAIN" chaque polyligne, mais c long et fastidieux !

 

Voila donc mon CCTP/CDC :

 

- Selection AutoCAD classique puis filtrage pour ne traiter que les polylignes 2D

 

- Si la polyligne 2D a la MEME largeur sur TOUT son parcours, on ne la touche pas !

 

- Si la polyligne change de largeur a un sommet N par rapport au sommet N-1, on coupe au sommet N tout simplement ! et ainsi de suite ...

 

Donc si une polyligne (composee de 10 segments ou arcs) change de largeur physique a chaque sommet et bien on obtiendra 10 polylignes de UN segment ou arc !

 

J'aimerais bien sur garder les eventuels XDATAs

 

et encore mieux les eventuels Object Datas (si possible) de MAP/CIVIL ou sinon avec la routine COPY_OD.lsp, je pourrais toujours a la main coper depuis la polyligne d'origine vers les N-1 polylignes generees !

 

Si la polyligne a une largeur de depart differente de la largeur de fin, on coupe aux 2 extremites pour obtenir une polyligne de UN segment ou arc

 

Voilu, voilo, voili - Suis je assez clair ?

 

Merci d'avance, le Decapode

 

 

 

[lecrabe]

 

Hello

 

Un petit UP pour voir !?

 

Merci, le Decapode

 

[(gile)]

Salut,

 

Pas testé en profondeur (ni pour les ObjectData, mais j'ai appelé les fonctions LISP de MAP qui le font).

 

Nouvelle version : meilleur traitement des segments aux largeur de départ et de fin différentes

 

Nouvelle version : réparé problème avec les polylignes fermées

 

(defun c:lecrabe (/ *error* ss n)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-Activedocument (vlax-get-acad-object))))
 (defun *error* (msg)
   (and msg
 (/= msg "Fonction annulée")
 (princ (strcat "\nErreur: " msg))
 )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )
 (vla-StartUndoMark *acdoc*)
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ""))))
   (repeat (setq n (sslength ss))
     (gc:BreakAtWidth (ssname ss (setq n (1- n))))
   )
 )
 (*error* nil)
)

;; massoc
;; Retourne la liste de toutes les valeurs pour le code spécifié dans une liste d'association
;;
;; Arguments
;; code : le code de groupe pour les entrées
;; alst : la liste d'association

(defun massoc (code alst)
 (if (setq alst (member (assoc code alst) alst))
   (cons (cdar alst) (massoc code (cdr alst)))
 )
)

;; gc:ChangePosition
;; Retourne l'index du premier élément différent de l'élément de départ
;;
;; Arguments
;; lst : la liste à traiter
;; start : index de départ
(defun gc:ChangePosition (lst start)
 (setq lst (gc:MemberAt start lst))
 (while (= (car lst) (cadr lst))
   (setq start	(1+ start)
  lst	(cdr lst)
   )
 )
 (if (cdr lst)
   (1+ start)
 )
)

;; gc:MemberAt
;; Retourne la liste à partir de l'index spécifié (complémentaire de gc:TruncAt)
;;
;; Arguments
;; ind : l'index
;; lst : la liste
(defun gc:MemberAt (ind lst)
 (repeat ind (setq lst (cdr lst)))
 lst
)

;; gc:TruncAt
;; Retourne la liste jusqu'à l'index spécifié (complémentaire de gc:MemberAt)
;;
;; Arguments
;; ind : l'index
;; lst : la liste
(defun gc:TruncAt (ind lst)
 (if (and lst (    (cons (car lst) (gc:TruncAt (1- ind) (cdr lst)))
 )
)

;; gc:BreakAtWidth
;; Coupe la polyligne à chaque changement de largeur
;;
;; Arguments
;; pl : la polyligne
(defun gc:BreakAtWidth (pl / elst dxf10 dxf40 dxf41 xdata ind1 ind2 start difse)
 (setq	elst  (entget pl '("*"))
dxf10 (massoc 10 elst)
dxf40 (massoc 40 elst)
dxf41 (massoc 41 elst)
dxf42 (massoc 42 elst)
xdata (assoc -3 elst)
ind1  (gc:ChangePosition dxf40 0)
ind2  (vl-position nil (mapcar '= dxf40 dxf41))
map   (and
	ade_odgettables	ade_odrecordqty	ade_oddelrecord	ade_odtabledefn	ade_odgetfield
	ade_odaddrecord	copy_data)
 )
 (cond
   ((and ind1 ind2)
    (if (       (setq start ind2
     difse   T
      )
      (setq start ind1)
    )
   )
   (ind1 (setq start ind1))
   (ind2
    (setq start ind2
   difse	 T
    )
   )
 )
 (if (and start (    (progn
     (if (= 1 (Boole 1 1 (cdr (assoc 70 elst))))
(foreach l '(dxf10 dxf40 dxf41 dxf42)
  (set l (append (eval l) (list (car (eval l)))))
)
     )
     (if difse
(if (= 0 start)
  (progn
    (entmod
      (append
	(vl-remove-if '(lambda (x) (member (car x) '(90 70 10 40 41 42 -3))) elst)
	(list
	  (cons 90 2)
	  (cons 70 (Boole 2 (cdr (assoc 70 elst)) 1))
	)
	(apply 'append
	       (mapcar 'list
		       (mapcar '(lambda (x) (cons 10 x)) (gc:TruncAt 2 dxf10))
		       (mapcar '(lambda (x) (cons 40 x)) (gc:TruncAt 2 dxf40))
		       (mapcar '(lambda (x) (cons 41 x)) (gc:TruncAt 2 dxf41))
		       (mapcar '(lambda (x) (cons 42 x)) (gc:TruncAt 2 dxf42))
	       )
	)
	(if xdata
	  (list xdata)
	)
      )
    )
    (setq start (1+ start))
  )
  (progn
    (entmod
      (append
	(vl-remove-if '(lambda (x) (member (car x) '(90 70 10 40 41 42 -3))) elst)
	(list
	  (cons 90 (1+ start))
	  (cons 70 (Boole 2 (cdr (assoc 70 elst)) 1))
	  (cons 43 (cdr (assoc 40 elst)))
	)
	(apply 'append
	       (mapcar 'list
		       (mapcar '(lambda (x) (cons 10 x)) (gc:TruncAt (1+ start) dxf10))
		       (mapcar '(lambda (x) (cons 42 x)) (gc:TruncAt (1+ start) dxf42))
	       )
	)
	(if xdata
	  (list xdata)
	)
      )
    )
    (entmake
      (append
	(vl-remove-if '(lambda (x) (member (car x) '(-1 5 10 40 41 42 90 70 -3))) elst)
	(list
	  (cons 90 2)
	  (cons 70 (Boole 2 (cdr (assoc 70 elst)) 1))
	)
	(apply
	  'append
	  (mapcar 'list
		  (mapcar '(lambda (x) (cons 10 x)) (gc:TruncAt 2 (gc:MemberAt start dxf10)))
		  (mapcar '(lambda (x) (cons 40 x)) (gc:TruncAt 2 (gc:MemberAt start dxf40)))
		  (mapcar '(lambda (x) (cons 41 x)) (gc:TruncAt 2 (gc:MemberAt start dxf41)))
		  (mapcar '(lambda (x) (cons 42 x)) (gc:TruncAt 2 (gc:MemberAt start dxf42)))
	  )
	)
	(if xdata
	  (list xdata)
	)
      )
    )
    (and map (copy_data pl (entlast) nil))
    (setq start (1+ start))
  )
)
(entmod
  (append
    (vl-remove-if '(lambda (x) (member (car x) '(90 70 10 40 41 42 -3))) elst)
    (list
      (cons 90 (1+ start))
      (cons 70 (Boole 2 (cdr (assoc 70 elst)) 1))
      (cons 43 (cdr (assoc 40 elst)))
    )
    (apply 'append
	   (mapcar 'list
		   (mapcar '(lambda (x) (cons 10 x)) (gc:TruncAt (1+ start) dxf10))
		   (mapcar '(lambda (x) (cons 42 x)) (gc:TruncAt (1+ start) dxf42))
	   )
    )
    (if	xdata
      (list xdata)
    )
  )
)
     )
     (if (	(progn
  (entmake
    (append
      (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10 40 41 42 90 70 -3))) elst)
      (list
	(cons 90 (- (length dxf10) start))
	(cons 70 (Boole 2 (cdr (assoc 70 elst)) 1))
      )
      (apply 'append
	     (mapcar 'list
		     (mapcar '(lambda (x) (cons 10 x)) (gc:MemberAt start dxf10))
		     (mapcar '(lambda (x) (cons 40 x)) (gc:MemberAt start dxf40))
		     (mapcar '(lambda (x) (cons 41 x)) (gc:MemberAt start dxf41))
		     (mapcar '(lambda (x) (cons 42 x)) (gc:MemberAt start dxf42))
	     )
      )
      (if xdata
	(list xdata)
      )
    )
  )
  (and map (copy_data pl (entlast) nil))
  (gc:BreakAtWidth (entlast))
)
     )
   )
 )
)

[lecrabe]

 

 

Hello Gilles

 

Ici nous sommes submerge par la neige : Region de Chambery : Aix les Bains

40 cm de neige sur la voiture ce matin ! :)

 

J'ai teste ton programme sur MAP 2006 FRA et sur MAP 2010 English,

un seul mot : BRAVO BRAVIO BRAVO !! :D

 

Avec un dessin un peu torture + Xdata + OD de MAP (ou Civil)

et comme d'habitude, ca marche Nickel-Chrome !!

 

Au fait je crois que tu n'as pas (ou plus) de Map ou Civil operationnel !

Donc comment fais tu pour tester ta routine qui appelle des fonctions de MAP ?

 

Et si on fait tourner ta routine sur AutoCAD ou sur A D T , que se passe t-il ?

Elle plante du fait de l'appel des routines OD ??

 

Cette question pour signaler eventuellement les lignes a supprimer ... :P

Pour ceux qui ont simplement un AutoCAD ou un A D T

 

Encore MERCI, Le Decapode

 

 

[(gile)]

Salut,

 

Tout d'abord j'ai encore modifié la routine (problème avec le traitement des polylignes fermées).

 

Au fait je crois que tu n'as pas (ou plus) de Map ou Civil operationnel !

Donc comment fais tu pour tester ta routine qui appelle des fonctions de MAP ?

 

Et si on fait tourner ta routine sur AutoCAD ou sur A D T , que se passe t-il ?

Elle plante du fait de l'appel des routines OD ??

MAP (et j'imagine Civil) fournit des routines LISP spécifique pour le traitement des ObjectData (OD). Par exemple, la fonction CopyData copie les OD d'une entité sur une autre.

Je ne peux pas tester si CopyData fonctionne (je n'ai plus MAP) mais cette fonction est appelée si elle est chargée (ainsi que ade_odgettables, ade_odrecordqty, ade_oddelrecord, ade_odtabledefn, ade_odgetfield et ade_odaddrecord, toute des fonctions spécifiques).

 

En résumé : si , les fonctions spécifiques MAP sont chargées CopyData est appelée, sinon, non.

Donc la routine ci-dessus fonctionne aussi bien sur MAP/Civil (avec copie des OD) que sur un AutoCAD standard (ou Architecture, Mechanical, ...).

[lecrabe]

 

Hello

 

Un seul mot : BRAVISSIMO ! :)

 

Merci, Le Decapode

 

[lecrabe]

 

ReHello

 

SVP si qq 'un pouvait faire un test en AutoCAD 64 bits (2010 ou 2011), cela serait sympa !?

 

Merci d'avance, Le Decapode

 

[(gile)]

J'ai fait mes tests sur A2011 64 bits.