Trouver Polylignes 2D avec Arc !?

[lecrabe]

 

Hello

 

N'ayant pas trouve mon bonheur, je fais appel "aux cakes" du Forum

 

Je desire une routine pour trouver, selectionner et forcer dans une couleur toutes les polylignes 2D ayant au moins UN arc dans leur geometrie

 

Ces polylignes 2D peuvent avoir 2 sommets seulement (et donc peut etre un simple arc)

ou N sommets avec X segments et Y arcs ...

 

C pour les trouver facilement et les "rectifier" plus tard ...

 

--- Deroulement de la routine ---

 

Demande du code couleur (1-255) pour le forcage ulterieure de la couleur

 

Selection classique AutoCAD

 

Forcage des polylignes 2D ayant au moins UN arc dans la couleur voulue

 

Resultat : N polylignes 2D selectionnees dont M ont ete forcees ...

 

Merci d'avance et Bon Dimanche a tous, Le Decapode

 

[(gile)]

Salut,

 

Tiens, j'ai mangé du crabe avant hier...

 

(defun c:test1 (/ col ss tot cnt lst pa)
 (vl-load-com)
 (if (and
       (setq col (acad_colordlg 7 nil))
       (ssget '((0 . "LWPOLYLINE")))
     )
   (progn
     (setq tot 0
           cnt 0
     )
     (vlax-for pl (setq ss (vla-get-ActiveSelectionSet
                             (vla-get-ActiveDocument (vlax-get-acad-object))
                           )
                  )
       (setq tot (1+ tot)
             lst nil
       )
       (repeat (setq pa (fix (vlax-curve-getEndParam pl)))
         (setq lst (cons (vla-getBulge pl (setq pa (1- pa))) lst))
       )
       (if (vl-some '(lambda (x) (/= 0.0 x)) lst)
         (progn
           (vla-put-Color pl col)
           (setq cnt (1+ cnt))
         )
       )
     )
     (vla-delete ss)
     (princ
       (strcat (itoa tot)
               " polyligne(s) sélectionnée(s), "
               (itoa cnt)
               " forcées"
       )
     )
   )
 )
 (princ)
)

[(gile)]

La même avec AutoLISP

 

(defun c:test2 (/ col ss tot cnt pl elst)
 (if (and
       (setq col (acad_colordlg 7 nil))
       (setq ss (ssget '((0 . "LWPOLYLINE"))))
     )
   (progn
     (setq tot 0
           cnt 0
     )
     (while (setq pl (ssname ss tot))
       (setq elst (entget pl)
             tot  (1+ tot)
       )
       (if (vl-some '(lambda (x) (and (= (car x) 42) (/= (cdr x) 0))) elst)
         (progn
           (entmod
             (cons
               (car elst)
               (cons
                 (cadr elst)
                 (cons
                   (cons 62 col)
                   (vl-remove-if '(lambda (x) (member (car x) '(62 420 430)))
                                 (cddr elst)
                   )
                 )
               )
             )
           )
           (setq cnt (1+ cnt))
         )
       )
     )
     (princ
       (strcat (itoa tot)
               " polyligne(s) sélectionnée(s), "
               (itoa cnt)
               " forcées"
       )
     )
   )
 )
 (princ)
)

[lecrabe]

 

Hello Gilles

 

Désolé pour le retard mais les vacances m'ont obligé à lever "un peu le pied" !

 

J'ai testé tes 2 routines Lisp et VLisp avec MAP 3D 006 et comme d'hab., c parfait ! :)

 

Merci, Le Decapode