Classement

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)) ) ) ) ) )