Classement

Salut @lili2006, En promo sous les 1000€ : https://www.ldlc.pro/fiche/PB00542062.html Au même prix (24Go RAM au lieu de 16, et Ryzen 7 au lieu de i7), même si je suis "anti lenovo" : https://www.ldlc.pro/fiche/PB00628356.html Olivier

Franchement je ne vois pas comment, le code d'Evgeniy emploi des fonctions récursives et utilise (entmake) pour la création d'entité. Ce procédé est la meilleure façon, même mieux qu'ActiveX qui est pourtant très bien aussi au niveau rapidité et plus simple à construire. En NetC se serait peut être plus rapide mais je ne pratique pas. Pour en revenir au programme; Lecrabe m'a pointé du doigt un dysfonctionnement (non prise en compte des arrondis dans le Mpolygone).J'ai repris l'écriture et pense avoir résolu le problème, voici cette version. (defun createhatchlist (e) (if e (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) (entget e)) ) ) (defun entmakex-hatch (l a n s lay) ;; By ElpanovEvgeniy ;; L - list point ;; A - angle hatch ;; N - name pattern ;; S - scale ;; return - hatch ename (entmakex (apply 'append (list (list '(0 . "HATCH") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbHatch") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0) (cons 2 n) lay (if (= n "SOLID") '(70 . 1) '(70 . 0) ) ;_ if '(71 . 0) (cons 91 (length l)) ) ;_ list (apply 'append (mapcar '(lambda (a) (apply 'append (list (list '(92 . 7) '(72 . 1) '(73 . 1) (cons 93 (/ (length a) 2))) a '((97 . 0)) ) ;_ list ) ;_ apply ) ;_ lambda l ) ;_ mapcar ) ;_ apply (list '(75 . 0) '(76 . 1) (cons 52 a) (cons 41 s) '(77 . 0) '(78 . 1) (cons 53 a) '(43 . 0.) '(44 . 0.) '(45 . 1.) '(46 . 1.) '(79 . 0) '(47 . 1.) '(98 . 2) '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 1) '(462 . 1.0) '(453 . 2) '(463 . 0.0) '(463 . 1.0) '(470 . "LINEAR") ) ;_ list ) ;_ list ) ;_ apply ) ;_ entmakex ) (defun f (l i) (if (> i 0) (if (assoc 42 l) (cons (mapcar (function +) (car (member (assoc 10 l) l)) v) (cons (assoc 42 l) (f (cddr (member (assoc 10 l) l)) (1- i)))) (cons (mapcar (function +) (car (member (assoc 10 l) l)) v) (f (cdr (member (assoc 10 l) l)) (1- i))) ) ) ) (defun c:MP2PHATCHOD (/ hList tmp e dxf_e jspl v tbldef lst_data numrec tmp_rec nwent ct l lst ll p nbe) ;; by ElpanovEvgeniy, modified by Valsecchi Bruno ;; convert MPolygon to Lwpolyline and Hatch with OD for map ;; version 0.2 ;; 2012.07.11 ;; mailto: elpanov@gmail.com ;; web: elpanov.com (if (setq v (ssget '((0 . "MPOLYGON")))) (foreach e (mapcar (function cadr) (ssnamex v)) (setq hList nil tmp nil lst_data nil) (cond ((eq (type e) 'ENAME) (foreach n (ade_odgettables e) (setq tbldef (ade_odtabledefn n)) (setq lst_data (cons (mapcar '(lambda (fld / tmp_rec numrec) (setq numrec (ade_odrecordqty e n)) (cons n (while (not (zerop numrec)) (setq numrec (1- numrec)) (if (zerop numrec) (if tmp_rec (cons fld (list (cons (ade_odgetfield e n fld numrec) tmp_rec))) (cons fld (ade_odgetfield e n fld numrec)) ) (setq tmp_rec (cons (ade_odgetfield e n fld numrec) tmp_rec)) ) ) ) ) (mapcar 'cdar (cdaddr tbldef)) ) lst_data ) ) ) (setq dxf_e (entget e) jspl (ssadd) v (cons 0 (mapcar (function -) (cdr (assoc 11 dxf_e)) (cdr (assoc 10 dxf_e)))) l (vl-remove nil (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 67 dxf_e) (assoc 410 dxf_e) (assoc 8 dxf_e) (if (assoc 63 dxf_e) (cons 62 (cdr (assoc 63 dxf_e))) ) (if (assoc 421 dxf_e) (cons 420 (cdr (assoc 421 dxf_e))) ) '(100 . "AcDbPolyline") ) ) lst dxf_e ll nil ) (while (setq lst (member (assoc 93 (cdr lst)) (cdr lst))) (setq p (f (cdr lst) (cdar lst)) ll (append ll (list '(92 . 7) '(72 . 0) '(73 . 1) (car lst)) p '((97 . 0))) ) (entmakex (vl-remove nil (append l (list (cons 90 (cdar lst)) '(70 . 1)) p (list (assoc 210 dxf_e))))) (setq nwent (entlast)) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty (cdar dxf_e) (caar x))) (ade_odaddrecord nwent (caar x)) ) (foreach el (mapcar 'cdr x) (if (listp (cdr el)) (progn (setq ct -1) (mapcar '(lambda (y / ) (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y) ) (cadr el) ) ) (ade_odsetfield nwent (caar x) (car el) 0 (cdr el)) ) ) ) lst_data ) ) ) (setq jspl (ssadd nwent jspl)) ) (repeat (setq nbe (sslength jspl)) (if (setq tmp (CreateHatchList (ssname jspl (setq nbe (1- nbe))))) (setq hList (cons tmp hList)) ) ) ) ) (entmakex-hatch (reverse hList) 0.0 "_SOLID" 1.0 (assoc 8 dxf_e)) (setq nwent (entlast)) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty (cdar dxf_e) (caar x))) (ade_odaddrecord nwent (caar x)) ) (foreach el (mapcar 'cdr x) (if (listp (cdr el)) (progn (setq ct -1) (mapcar '(lambda (y / ) (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y) ) (cadr el) ) ) (ade_odsetfield nwent (caar x) (car el) 0 (cdr el)) ) ) ) lst_data ) ) ) ) ) (princ) )