sélection de polylignes apr le nombre de sommets

[philsogood]

hello

je suis bien embété je dois sélectionner des polylignes avec un nombre trop important de sommets

le fichier est destiné à être utilisé sous Revit et l'export d'une polyligne est décomposé en x lignes (x = nombre de sommets -1)

revit n'aime aps avoir trop d'objets à importer et il ma faut limiter le plus possible ces polylignes à rallonge

pour ce faire je dois être à même de les sélectionner mais ça n'est pas possible de la fenètre SELECTRAP

du coup, comment feriez-vus pour sélectionner des plylignes avec x sommets (ou plus) et d'une longueur iféiruere à a?

merci pour vos retours

Phil

[Curlygoth]

De la programmation 😉

En natif je suis pas sur que ça existe...

[Fraid]

Bonjour,

Je t'ai fait cela,

(vl-load-com)
;;;getpoltorevit
;;;Séléctionne Les polylignes selon le nombre de segments et leur longueur
;;;Utilise les fonctions getptpol et multidcl
;;;La sauvegarde des critères se fait dans le dossier du dessin en cours.
(defun c:getpoltorevit (/ ini rid wri l nb lg n spol pol sel)
    (if (setq ini (findfile "inigetpoltorevit.txt"))
        (progn
            (setq rid (open ini "r")
                    nb (atoi (read-line rid))
                    lg (atof (read-line rid))
            )
            (close rid)
        )
        (progn
            (setq l (multidcl '("GetPolToRevit" "Nombre Mini de segments :" "Longueurs Maxi de la Polyligne :" (" : Enregister" "0")))
                   nb (atoi(car l))
                   lg (atof (cadr l))
            )
            (if (= (caddr l) "1")
                (progn
                    (setq wri (open (strcat (getvar 'DWGPREFIX) "inigetpoltorevit.txt")"w"))
                    (write-line (car l) wri)
                    (write-line (cadr l) wri)
                    (close wri)
                )
            )
        )
    )
    (setq n -1
           sel (ssadd)
    )
    (if (setq spol (ssget "_x" '((0 . "LWPOLYLINE"))))
      (progn
        (while (setq pol (ssname spol (setq n (1+ n))))
            (if (and(>= (1-(length (getptpol (vlax-ename->vla-object pol)))) nb)
                     (<= (vla-get-Length (vlax-ename->vla-object pol)) lg)
                 )
                (setq sel (ssadd pol sel))
            )
        )
        (if (> (sslength sel) 0)
            (progn
                (princ (strcat "\n " (itoa (sslength sel)) " Polylignes séléctionnées"))
                (sssetfirst nil sel)                
            )
            (princ "\nAucune Polyligne séléctionnée")
        )
      )
      (princ "\nAucune Polyligne dans le dessin")
    )
    (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;getptpol
;;;Retourne la liste des points d'une Polyligne
;;;Arg: Objet VLA
;;;Retour: Liste de points
(defun getptpol (obj / pts)
  (setq pts (util-pair (vlax-get obj 'coordinates)))
  (if (vlax-curve-isClosed  obj) (setq pts (append pts (list (car pts)))))
  pts
)
(defun util-pair (l)
  (if l
    (cons (list (car l) (cadr l)) (util-pair (cddr l)))
  )
)
;;;multidcl
;;;DCL adaptatif
;;;Arg :ldcl, liste
;;;Retour : Liste des valeurs choisies ou nil
;;;Exemple (multidcl '("Test" "Nom :" (" : Visible" "1")(" : Imprimable" "0")("Nombre :" ("1" "2" "3"))))
(defun multidcl (ldcl / tdcl n tfct star acts vals vdef dcltmp odcl fct ofct ret)
    (setq tdcl (strcat (car ldcl) " :dialog {label = \"" (car ldcl) "\"; :boxed_column { ") n 0
           tfct (strcat "(defun fcttmp (dcl name li / dcl_id done ")
           star "" acts "" vals "" vdef ""
    )
    (foreach dc (cdr ldcl)
        (cond  ((= (type dc) 'STR)
                    (setq   tdcl    (strcat tdcl ":edit_box { 
                                                    key = \"til" (itoa (setq n (1+ n))) "\"; 
                                                    label = \"" dc "\"; 
                                                    edit_width = 20; 
                                                    }"
                                    )
                            vals (strcat vals " val" (itoa n))
                            vdef (strcat vdef " val" (itoa n) " \"\"")
                            acts (strcat acts "(action_tile \"til" (itoa n) "\" \"(setq val"(itoa n)" $value)\")")
                    )
                )
                ((= (type (cadr dc)) 'STR)
                    (setq tdcl (strcat tdcl ":toggle { 
                                                    key = \"til" (itoa (setq n (1+ n))) "\"; 
                                                    label = \"" (car dc) "\"; 
                                                    value = \"" (cadr dc) "\";}"
                                )
                            vals (strcat vals " val" (itoa n))
                            vdef (strcat vdef " val" (itoa n) " \"" (cadr dc)"\"")
                            acts (strcat acts "(action_tile \"til" (itoa n) "\" \"(setq val"(itoa n)" $value)\")")
                    )
                )
                ( T (setq tdcl (strcat tdcl ":popup_list { 
                                                    key = \"til" (itoa (setq n (1+ n))) "\"; 
                                                    label = \"" (car dc) "\"; 
                                                    edit_width = 20;}"
                                )
                            vals (strcat vals " val" (itoa n))
                            vdef (strcat vdef " val" (itoa n) " \"" (caadr dc)"\"")
                            star (strcat star "(start_list \"til" (itoa n) "\")
                                    (mapcar 'add_list (cadr (nth "(itoa (1- n))" (cdr li))))
                                    (end_list)"
               
                                )
                            acts (strcat acts "(action_tile \"til" (itoa n) "\" \"(setq val" (itoa n) " (nth (atoi $value) (cadr (nth "(itoa (1- n))" (cdr li)))))\")")
                    )
                )
        )
    )
    (setq tdcl (strcat tdcl "} spacer; ok_cancel; }")
           dcltmp (vl-filename-mktemp "tmp.dcl")
           odcl (open dcltmp "w")
           
    )
    (write-line tdcl odcl)
    (close odcl)
    (setq   tfct (strcat tfct   
                                vals 
                                ")(if (new_dialog \""
                                (car ldcl) 
                                "\" (setq dcl_id (load_dialog dcl)))(progn (setq " 
                                vdef
                                ")"
                                star
                                acts 
                                "(action_tile \"cancel\" \"(done_dialog 0)\")
                                 (action_tile \"accept\" \"(done_dialog 1)\")
                                 (setq done (start_dialog))
                                 (unload_dialog dcl_id)
                                 (if (= done 1)(list " 
                                 vals 
                                 ")
                                 nil
                                 )
                                 )))"
                )
            fct  (vl-filename-mktemp "fct.lsp")
            ofct (open fct "w")
    )
    (write-line tfct ofct)
    (close ofct)
    (load fct)
    (setq ret (fcttmp dcltmp (car ldcl) ldcl))
    (vl-file-delete dcltmp)
    (vl-file-delete fct)
    ret
)

tu tape getpoltorevit

Dit moi si ça fonctionne, je n'ai pas trop le temps de faire des testes approfondis.

Modifié le 4 juin 2021 par Fraid

[philsogood]

hello Fraid

j'ai lancé la commande et voila ce que j'ai obtenu comme réponse :

Quote

; erreur: no function definition: UTIL-PAIR

Phil

[Fraid]

Yop, désolé je l'avais oubliée

j'ai modifié le code

je savais bien que j'allais un peu vite...

[philsogood]

nickel Fraid

si tu peux faire sauter la case "enregistrer" c'est juste parfait!! :)

Phil

[Fraid]

29 minutes ago, philsogood said:

faire sauter la case "enregistrer"

Je l'ai désactivée par défaut, tu n'as plus à décoché ...

mais je l'ai laissé

c'étais l'occasion de tester la fonction multidcl, qui se trouve donc bien pratique pour un petit dcl vite fait.