Aller au contenu

MPolygon vers Hachures en preservant les Object Data (OD)


totor2027

Messages recommandés

Bonjour le forum,

Je suis nouveau dans le monde d'autocad et de la programmation lisp.

J’utilise actuellement le lisp de Elpanov afin de convertir des MPolygon en Hachures, ces objets contiennent également des « Object data » qui ne sont pas conservé pendant la conversion.

Autodesk (pour la version MAP) donne un lsp (COPY_OD) qui permet de copier les « object data » d’un objet sélectionné vers un autre.

J’aimerais pourvoir fusionner ces deux scripts en un seul permettant la conversion des Mpolygon vers des hachures en conservant les « Object data » associés aux objets.

Malheureusement je n’ai pas le niveau pour le faire, merci par avance pour l'aide apporté.

 

Script utilisés :

- mp2p

 

(defun c:mp2p (/ L LL LST P V)
 ;; by ElpanovEvgeniy
 ;; convert MPolygon to Lwpolyline
 ;; version 0.2
 ;; 2012.07.11
 ;; mailto: elpanov@gmail.com
 ;; web:    elpanov.com
 (if (setq v (ssget "_x" '((0 . "MPOLYGON"))))
   (foreach e (mapcar (function cadr) (ssnamex v))
     ;;(setq e(car(entsel)))
     (setq e   (entget e)
           v   (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
           l   (vl-remove nil
                          (list '(0 . "LWPOLYLINE")
                                '(100 . "AcDbEntity")
                                (assoc 67 e)
                                (assoc 410 e)
                                (assoc 8 e)
                                (if (assoc 63 e)
                                  (cons 62 (cdr (assoc 63 e)))
                                )
                                (if (assoc 421 e)
                                  (cons 420 (cdr (assoc 421 e)))
                                )
                                '(100 . "AcDbPolyline")
                          )
               )
           lst e
           ll  nil
     )
     (defun f (l i)
       (if (> i 0)
         (cons (mapcar (function +) (car l) v) (f (cdr l) (1- i)))
       )
     )
     (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 e)))))
     )
     (entmakex (vl-remove nil
                          (append (list '(0 . "HATCH")
                                        '(100 . "AcDbEntity")
                                        (assoc 410 l)
                                        (assoc 8 l)
                                        (assoc 62 l)
                                        (assoc 420 l)
                                        '(100 . "AcDbHatch")
                                        (assoc 10 e)
                                        (assoc 210 e)
                                        '(2 . "SOLID")
                                        (assoc 70 e)
                                        (assoc 71 e)
                                        (assoc 91 e)
                                  )
                                  ll
                                  (list '(75 . 0)
                                        '(76 . 1)
                                        '(47 . 1.)
                                        '(98 . 2)
                                        '(10 0. 0. 0.0)
                                        '(10 0. 0. 0.0)
                                        '(450 . 0)
                                        '(451 . 0)
                                        '(460 . 0.0)
                                        '(461 . 0.0)
                                        '(452 . 0)
                                        '(462 . 0.0)
                                        '(453 . 2)
                                        '(463 . 0.0)
                                        '(63 . 256)
                                        '(463 . 1.0)
                                        '(63 . 256)
                                        '(470 . "LINEAR")
                                  )
                          )
               )
     )
   )
 )
 (princ)
)

 

- COPY_OD

;;;---------------------------------------------------------------------------;
;;;
;;;    COPY_OD.LSP
;;;
;;;    (C) Copyright 1998 by Autodesk, Inc.
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;    July 1996
;;; 
;;;---------------------------------------------------------------------------;
;;;
;;;    DESCRIPTION
;;;
;;;    Copy object data from one object to a set of other objects. If the
;;;    object data to be copied already exists on the target object the
;;;    options to not copy, copy once and copy all are presented.
;;;
;;;    Careful, it is possible to corrupt existing topological data
;;;    using this routine.
;;;
;;;---------------------------------------------------------------------------;

;;;****************************************************************************
;;; Function: C:COPY_OD
;;;
;;; Main routine for copying object data from an object to
;;; a selection set of object. 
;;;
;;;
(defun C:COPY_OD ( 
 /
 source_obj                 ; source object
 target_obj                 ; target object
 target_ss                  ; target selection set
 ct                         ; count
 len                        ; length
 overwrite                  ; overwrite flag
 error                      ; old error function
 )
 
 (setq error *error*)
 ;;
 ;; Define error handler
 ;;
 (defun *error* (msg)
   (alert msg)
   (setq *error* error)
   (exit)
 )
 
 ;;
 ;; Input the source object to copy data from
 ;;
 (princ "\nSelect SOURCE object: ")
 (setq source_obj (car (entsel)))
 (if (null source_obj)
   (prompt "\nNo source object selected.")
   (progn
     ;;
     ;; If the object has object data attached process it
     ;;
     (if (null (ade_odgettables source_obj))
       (princ "\nSelected object contains no object data.")
       (progn
         (princ "\n\nSelect TARGET objects: ")
         (setq target_ss (ssget))
         (if (null target_ss)
           (prompt "\nNo target object selected.")
           (progn
             (setq len (sslength target_ss))
             (setq ct 0)
             (princ "\nCopying object data...")
             (while (< ct len)
               (setq target_obj (ssname target_ss ct))
               (redraw target_obj 3)
               (setq ct (+ ct 1))
               (setq overwrite (COPY_DATA source_obj target_obj overwrite))
               (redraw target_obj 4)
             )
           )
         );if
       )
     );if
   )
 );if   
 
 (setq *error* error)                                ;restore error handler
 
 (prompt "\nProcessing completed.")
 (princ)
 
);C:COPY_OD

;;;****************************************************************************
;;; Function: C:COPY_DATA
;;;
;;; Copy object data from the source object to the target object.
;;;
;;; If the data is already found to exist on a target object, the 
;;; user is prompted what to do. Either to replace it only on the 
;;; target, for all objects in  the selection set, or to skip it.
;;;
;;;
(defun COPY_DATA (
 source_obj
 target_obj
 overwrite                   ; overwrite flag
 / 
 ct        ct2 
 cttemp    fld 
 fldnme    fldnamelist 
 fldtyp    fldtypelist
 len       numrec 
 OK        tbl 
 tbllist   tbldef 
 tblstr    val 
 vallist 
 )

 ;; 
 ;; access all OD tables from source object
 ;;
 (if (setq tbllist (ade_odgettables source_obj))
   (progn
     ;;
     ;; for each table on source object
     ;;
     (foreach tbl tbllist
        (prompt (strcat "\nProcessing source table " tbl "."))
        ;;
        ;; determine if target object has object
        ;; data records for current table
        ;;
        (setq OK nil)
        (setq numrec (ade_odrecordqty target_obj tbl))
        ;;
        ;; If the table is found on object ask what to do
        ;;
        (if (and (> numrec 0) (/= overwrite "All"))
          (progn
            (initget "All Yes No")
            (setq overwrite (getkword "\nOverwrite existing record(s) on target? (All/Yes/No) <All>: "))
            (if (null overwrite)
              (setq overwrite "All")
            )
          )
        )
        (if (or (= overwrite "All") 
                (= overwrite "Yes")
                (= numrec 0)
            )
           (setq OK T)
        )
        ;;
        ;; delete all existing records on target 
        ;; object if overwrite flag is set
        ;;
        (if (and (> numrec 0)
                 (or (= overwrite "Yes")(= overwrite "All"))
            )
          (progn
            (setq ct 0)
            (while (< ct numrec)
              (ade_oddelrecord target_obj tbl ct)
              (setq ct (+ ct 1))
            )
          ) 
        )
        (if OK
          (progn
           ;;
           ;; build list of field names
           ;;
           (setq tbldef (ade_odtabledefn tbl))
           (setq tblstr (cdr (nth 2 tbldef)))
           (setq fldnamelist ())
           (setq fldtypelist ())
           (foreach fld tblstr
             (setq fldnme (cdr (nth 0 fld)))
             (setq fldtyp (cdr (nth 2 fld)))
             (setq fldnamelist (append fldnamelist (list fldnme)))
             (setq fldtypelist (append fldtypelist (list fldtyp)))
           )
           ;;
           ;; for each record on source object 
           ;;
           (setq numrec (ade_odrecordqty source_obj tbl))
           (setq ct 0)
           (while (< ct numrec)
             ;;
             ;; build list of values
             ;;
             (setq cttemp 0)
             (setq vallist ())
             (foreach fld fldnamelist
               (setq typ (nth cttemp fldtypelist))
               (setq cttemp (+ cttemp 1))
               (setq val (ade_odgetfield source_obj tbl fld ct))
               (if (= typ "Integer")(setq val (fix val)))
               (setq vallist (append vallist (list val)))
             )
             ;;
             ;; add a record to target object
             ;;
             (ade_odaddrecord target_obj tbl)
             ;;
             ;; populate target record with values from source record
             ;;
             (setq ct2 0)
             (while (< ct2 (length vallist))
               (setq val (nth ct2 vallist))
               (setq fld (nth ct2 fldnamelist))
               (setq ct2 (+ ct2 1))
               (ade_odsetfield target_obj tbl fld ct val)
             )
             (setq ct (+ ct 1))
           );while
         )
       );if
     );foreach
   )
 );if
 
 ;;
 ;; Return overwrite status so it can 
 ;; be passed back in for the next object.
 ;; 
 overwrite
  
);COPY_DATA

(prompt "\nType: COPY_OD to copy object data.")
(princ)

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

J'ai modifié le lisp d'Evgeniy, à voir si ça convient....

(defun c:mp2p (/ L LL LST P V tbldef lst_data numrec tmp_rec nwent ct)
 ;; by ElpanovEvgeniy
 ;; convert MPolygon to Lwpolyline
 ;; version 0.2
 ;; 2012.07.11
 ;; mailto: elpanov@gmail.com
 ;; web:	elpanov.com
 (if (setq v (ssget "_X" '((0 . "MPOLYGON"))))
(foreach e (mapcar 'cadr (ssnamex v))
 	(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 e   (entget e)
           	v   (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
           	l   (vl-remove nil
                          	(list '(0 . "LWPOLYLINE")
                                	'(100 . "AcDbEntity")
                                	(assoc 67 e)
                                	(assoc 410 e)
                                	(assoc 8 e)
                                	(if (assoc 63 e)
                                  	(cons 62 (cdr (assoc 63 e)))
                                	)
                                	(if (assoc 421 e)
                                  	(cons 420 (cdr (assoc 421 e)))
                                	)
                                	'(100 . "AcDbPolyline")
                          	)
               	)
           	lst e
           	ll  nil
     	)
     	(defun f (l i)
       	(if (> i 0)
         	(cons (mapcar (function +) (car l) v) (f (cdr l) (1- i)))
       	)
     	)
     	(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 e)))))
     	)
     	(entmakex (vl-remove nil
                          	(append (list '(0 . "HATCH")
                                        	'(100 . "AcDbEntity")
                                        	(assoc 410 l)
                                        	(assoc 8 l)
                                        	(assoc 62 l)
                                        	(assoc 420 l)
                                        	'(100 . "AcDbHatch")
                                        	(assoc 10 e)
                                        	(assoc 210 e)
                                        	'(2 . "SOLID")
                                        	(assoc 70 e)
                                        	(assoc 71 e)
                                        	(assoc 91 e)
                                  	)
                                  	ll
                                  	(list '(75 . 0)
                                        	'(76 . 1)
                                        	'(47 . 1.)
                                        	'(98 . 2)
                                        	'(10 0. 0. 0.0)
                                        	'(10 0. 0. 0.0)
                                        	'(450 . 0)
                                        	'(451 . 0)
                                        	'(460 . 0.0)
                                        	'(461 . 0.0)
                                        	'(452 . 0)
                                        	'(462 . 0.0)
                                        	'(453 . 2)
                                        	'(463 . 0.0)
                                        	'(63 . 256)
                                        	'(463 . 1.0)
                                        	'(63 . 256)
                                        	'(470 . "LINEAR")
                                  	)
                          	)
               	)
     	)
     	(setq nwent (entlast))
     	(cond
       	(lst_data
         	(mapcar
           	'(lambda (x / ct)
             	(while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty (cdar 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)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Hello Bruno

 

Desole mais sur mon MAP 2016 W64 :

 

Commande: MP2PHATCHOD

; erreur: liste incorrecte: -1.0

-- KEZAKO ??

 

Pour totor2027 : ca marche TEL QUEL chez toi ?

Avec quelle version de MAP 20XX ?

As tu modifie qq chose dans la routine de Bruno ?

 

MERCI, Bye, lecrabe "triste"

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

Bonjour Patrice,

A vrai dire je n'avais pas trop testé en profondeur la procédure d'Evgeniy. Mes tests superficiel sur Map 2019 avaient fonctionné.Mais je crois avoir découvert une coquille sur :

(mapcar (function cadr) (ssnamex v))

Cette fonction ne retourne pas qu'une liste d'entité, mais peut avoir en plus parfois une liste concernant le mode de sélection effectué et dans ce cas ne répond pas aux arguments demandés par la suite dans le code.Je rectifie le code précédent en rajoutant un contrôle sur cette liste.

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

@ lecrabe : Sous MAP 2018 (64), cela fonctionne sans changements, toutefois sur un gros jeux de données (19000) j'ai arrêté le traitement au bout d'une heure trente (test effectué sur un portable peut puissant).

je referai un test sur une station de travail la semaine prochaine.

 

Je suis en train d'établir un process d'échange de données entre Autocad et un SIG et inversement. Le but étant de redresser les données dans le SIG pour les reventiler ensuite dans N plans Autocad .

Les MP que je traite actuellement viennent d'une couche .SHP et les OD me permettent de faire des sélections attributaires afin de ventiler les données dans les différents plans.

 

@ bonuscad : y-a-t-il moyen (simple) pour accélérer le temps de traitement afin d'éviter le saucissonnage des données.

 

Merci encore à vous de prendre soins des petits nouveaux ;)

 

Guillaume

Lien vers le commentaire
Partager sur d’autres sites

@ bonuscad : y-a-t-il moyen (simple) pour accélérer le temps de traitement afin d'éviter le saucissonnage des données.

 

Merci encore à vous de prendre soins des petits nouveaux ;)

 

Guillaume

 

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

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

  • 2 semaines après...

Bonjour Bruno,

 

Je viens de tester la dernière version de ton script, il fonctionne à merveille.

Pour mes 19000 objets - de 3 minutes de traitement (waouh).

 

Toutefois j'ai juste une dernière demande, lors de la conversion les polylignes crées conserve bien le calque d'origine des Mpolygones en revanche les hachure sont toutes crées sur le calque actif.

 

Serait-il possible que les hachures soient également crées sur le calque d'origine des Mpolygones.

 

Merci par avance.

 

PS. Il n'y a pas d'urgence cela peut attendre les retour de congé :P .

Bonne fête à la communauté ;-)

 

Guillaume.

Lien vers le commentaire
Partager sur d’autres sites

Bonjour Guillaume,

J'ai modifié le code au post #11

En plus du calque, j'ai répondu aussi, dans la foulée à une demande de Patrice; mettre aussi les données d'objet sur les polylignes de contour; qui peut le plus, peut le moins...rolleyes.gif

cela peut attendre les retour de congé
Oui mais la demande aurait été au fond de la pile et je serais peut être passé à côté.tongue.gif

Bonnes fêtes également aux CADiens

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité