Trier (lw)polylignes 2D/3D

[Bred]

Salut,

 

Comme le post ici s'étalait et était hors-jujet, je poste ici une routine demandé par lecrabe :

 

Celle-ci permet de mettre les (lw)polylignes 2D et 3D dans des calques selons le critère de longueur ou de surface (une fourchette de valeur).

 

Vous devez, pour personnaliser la routine, modifier/rajouter des écarts dans la routine "list_tri_poly". (et modifier aussi "Nom_du_calque")

 

commande "tri-poly"

Choix de classement par défaut : Longueur

 

Nota :

1- je ne savais pas comment trouver la surface d'une polyligne "simple" (dites 3D), donc j'ai créer une routine qui calcul cette surface (vla-get-area2Dpoly3D) en projetant les point sur un plan.

2-repiquage de la routine LST2MAT et SUBLST de (gile).

 

;;; tri polyligne selon Surface ou longueur ;;;;;;;
;;;par Bred.

[b]; fourchette - à modifier-
(defun list_tri_poly ()
(list
"Nom_du_calque"
(cons 0 3)
(cons 4 9)
(cons 10 19)
)
)[/b]

;prog tri
(defun c:tri-poly (/ A I L LST Q SEL X)
(vl-load-com)

(initget "L S")
(setq Q (getkword "\n Tris des (LW)Polylignes par Calque : Longueur ou Surface (L/S) ? "))
(if (not Q )(setq Q "L"))

(setq sel (ssget '((0 . "*POLYLINE")))
lst (list_tri_poly))

(repeat (setq i (sslength sel))
(setq L (vla-get-length (vlax-ename->vla-object (ssname sel (setq i (1- i))))))
(if (equal (vla-get-ObjectName (vlax-ename->vla-object (ssname sel i))) "AcDb3dPolyline")
(setq A (vla-get-area2Dpoly3D (vlax-ename->vla-object (ssname sel i))))
(setq A (vla-get-area (vlax-ename->vla-object (ssname sel i))))
)

(if (equal Q "L")
(repeat (1- (setq x (length lst)))
(if (and (>= L (car (nth (setq x (1- x)) lst)))
(<= L (cdr (nth x lst))))
(entmod
(subst (cons 8 (strcat (car lst) "-"
(rtos (car (nth x lst)))
"_" (rtos (cdr (nth x lst)))))
(assoc 8 (entget (ssname sel i)))
(entget (ssname sel i))
))))
(repeat (1- (setq x (length lst)))
(if (and (>= A (car (nth (setq x (1- x)) lst)))
(<= A (cdr (nth x lst))))
(entmod
(subst (cons 8 (strcat (car lst) "-"
(rtos (car (nth x lst)))
"_" (rtos (cdr (nth x lst)))))
(assoc 8 (entget (ssname sel i)))
(entget (ssname sel i))
))))
)
)
(princ)
)

;;; LST2MAT Retourne un liste de listes du nombre
;;; d'éléments spécifié (matrice)
;;; (lst2mat '(1 2 3 4 5 6) 2) -> ((1 2) (3 4) (5 6))
;;; (lst2mat '(1 2 3 4 5 6) 3) -> ((1 2 3) (4 5 6))
(defun lst2mat (lst n)
(if (and lst (zerop (rem (length lst) n)))
(cons (sublst lst 1 n)
(lst2mat (sublst lst (1+ n) (- (length lst) n)) n)
)
)
)

;;; SUBLST Retourne une sous-liste
;;; Premier élément : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 -1) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 12) -> (3 4 5 6)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)
(defun sublst (lst start leng / rslt)
(if (not (<= 1 leng (- (length lst) start)))
(setq leng (- (length lst) (1- start)))
)
(repeat leng
(setq rslt (cons (nth (1- start) lst) rslt)
start (1+ start))
)
(reverse rslt)
)

; routine surface (2D) Polyligne (3D)
(defun vla-get-area2Dpoly3D (vla-poly3D / ACDOC AIRE COORD COORDF PLINE)
(setq AcDoc (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
)
coordF nil
coord (lst2mat (vlax-safearray->list
(vlax-variant-value (vla-get-coordinates vla-poly3D)))
3))
(foreach n coord (setq coordF (append coordF (list (car n) (cadr n) 0.0))))
(setq pline (vla-addPolyline AcDoc
(vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble (cons 0 (1- (length coordF))))coordF))))

(setq Aire (vla-get-area pline))
(vla-delete pline)
Aire
)

[lecrabe]

 

Hello

 

Encore merci Bred pour ton excellente routine :)

 

Une petite remarque, je l'ai utilisée avec ce genre de fourchette :

 

(cons 1 3)

(cons 3 10)

(cons 10 20)

(cons 20 50)

(cons 50 200)

 

Une polyligne ayant une surface ou longueur de 3 exactement sera transférée sur le 1er calque ! Cela me convient tout à fait !

 

Le Decapode "Bredant"