bonuscad

Bonjour, Merci pour le partage. Pour moi ça fonctionne nickel. J'ai adapté pour le "Lambert 93" et seul un site s'affiche bien au navigateur, c'est http://data.mapchannels.com/mm/dual2/map.htm Il faut dire qu'au boulot c'est Firefox ESR 24.3.0, qu'on peut pas installer de plugins. Pour google je n'aie que le plugin simplifié, et mappy c'est pas très probant, souvant une page semi-blanche. Mais bon ces problèmes ne sont en rien lié à ton code. Ca va me servir puisqu'un site est fonctionnel.

Cela fait partie de la routine (gile), là il a fait un code générique qui peut fonctionné avec plusieurs type d'entité. (ename) est le nom de l'entité retourné par exemple par (car (entsel)) ou (ssname (ssget) ind) ind etant l'indice dans le jeu de selection; compris entre 0 et (sslength (ssget)) Le mode de sélection Cp est Crossing Polygon (en anglais) -> Capture Polygone (en français) Le mode de sélection Wp est Window Polygon -> Fenêtre Polygone le filtre de sélection pour ne récupérer que la selection incluse dans le mode choisi par ex: '((0 . "INSERT") (8 . "Calque d'insertion")) pour ne recuperer que des bloc insérés dans le calque "Calque d'insertion". J'aurais dut d'ailleurs utilisé (SelByObj ent "CP" nil) dans le code proposé. Pour ton code il est censé fonctionner (ne peux tester) avec un dessin attaché, sur lequel il sera effectué une requête sur les données d'objets (OD) pour rapatrier les objets correspondants à la requête dans le dessin en cours. Ce code n'a rien de générique, il est bien spécifique au dessin à traiter (c'est un peu le genre de truc que je pratique, partager ce genre de code avec d'autre n'apporte rien à moins de savoir exactement ce qu'on veut en faire et être capable de le modifié dans l'optique voulue) Donc difficile pour le néophyte mais très avantageux pour celui qu'il l'a écrit, un gain de temps certain pour traiter une base importante sans faire des action répétitives avec les commandes de base d'AutocadMap.

Vous interpretez mes propos! je disais "pour ma part, j'essayerais de monter un lisp pour l'ocassion." Ce genre de développement qui ne servent généralement qu'une fois, donc faire un truc tip-top est pour moi une hérésie et une perte de temps. Je travaille beaucoup comme ça , constitution d'un lisp à la volée, mais comme je connais bien l'environnement dans lequel je travaille (je travaille avec une base importante, donc j'essayes d'automatiser le maximum d'opérations qui sont répétitives), je vise directement les données qu'il me faut et je ne m'attache pas à monter un code générique qui pourrait fonctionner dans d'autre cas. Donc il en résulte un code relativement court que je lance une fois puis, part généralement à la poubelle. Néanmoins pour illuster mon propos précédent, voici ce que j'aurais fais (ceci reste succint) ;;; SelByObj -Gilles Chanteau- 06/10/06 ;;; Crée un jeu de sélection avec tous les objets contenus ou ;;; capturés, dans la vue courante, par l'objet sélectionné ;;; (cercle, ellipse, polyligne fermée). ;;; Arguments : ;;; - un nom d'entité (ename) ;;; - un mode de sélection (Cp ou Wp) ;;; - un filtre de sélection ou nil ;;; ;;; modifié le 19/07/07 : fonctionne avec les objets hors fenêtre (vl-load-com) (defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst ss) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (vla-get-ObjectName obj) '("AcDbCircle" "AcDbEllipse")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 1 ) lst ) ) ) ) ((and (= (vla-get-ObjectName obj) "AcDbPolyline") (= (vla-get-Closed obj) :vlax-true) ) (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (trans (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) ent 1 ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 1 ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) (cond (lst (vla-ZoomExtents (vlax-get-acad-object)) (setq ss (ssget (strcat "_" opt) lst fltr)) (vla-ZoomPrevious (vlax-get-acad-object)) ss ) ) ) ;; ma partie qui se révèle assez courte ((lambda ( / ) (princ "\nSélectionnez un objet model fermé") (while (not (setq js (ssget "_+.:E:S" '( (0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>") ) ) ) ) ) (setq dxfl_cod (entget (ssname js 0)) lremov nil) (foreach m (foreach n dxfl_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxfl_cod (vl-remove (assoc m dxfl_cod) dxfl_cod)) ) (setq js (ssget "_X" dxfl_cod)) (cond (js (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n)))) (if (not (SelByObj ent "WP" nil)) (entdel ent)) ) ) ) )) J'ai fais un test rapide qui a fonctionné pour moi ATTENTION pendant le traitement, vous pouvez avoir l'impression qu'Autocad a planté (pas de réponse), laissez faire quand même (ne tuez pas la tache) il bosse quand même.

Pour ma part, j'essayerais de monter un lisp pour l'ocassion. Pour cela je ferais une boucle sur ces polylignes sélectionnées avec le filtre approprié. Pour chaque polyligne je ferais une selection en m'aidant, par exemple, de (SelByObj) de (gile) Si le selection retournée est vide, j'efface la polyligne Voilà en gros pour l'idée générale à mettre en oeuvre...

Bonjour, Vu le message retourné, j'essayerais dans un premier temps de faire un "zoom" "objet" sur la poly3d. Puis sans utiliser la molette d'exécuter la coupure. Je sais, si la poly est très longue, ça va pas être évident d'avoir le bon point de coupure... C'est juste pour voir si cela fonctionne mieux quand celle ci est entièrement affiché à l'écran. Si vraiment tu as besoin de d'effectuer un zoom, fais le avant et détermine ton point de coupure en lisp (setq pt (getpoint)) Reviens en zoom objet et pour la coupure tu lui donne le point !pt. C'est un peu de lourd comme démarche, mais c'est pour essayer d'affirmer/confirmer ce que j'entrevois comme problème (entité non- affichée entièrement à l'écran).

Tu ne devrais pas, l'ancienne comporte un bug sur la variable lst_pt qui est cumulée à chaque boucle. Donc vérifie bien que tu utilise la bonne routine, car le comportement que tu décrit je l'ai observé avec l'ancienne. Si tu es vraiment sûr, fait moi passer ton fichier d'exemple que je regarde à : ubuesque(at)mailoo.org Là dans l'immédiat je vois pas de causes...

Ben en réalité, c'est ce qu'il était censé de faire. J'ai juste oublié de réinitialiser la variable "lst_pt" dans la boucle! La correction: (vl-load-com) (defun c:min_z ( / js obj ename pr pt lst_pt lst_z id_seg nw_pt) (princ "\nSelectionner les polyligne3D: ") (while (null (setq js (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8))))) (princ "\nObjets non valable!") ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 lst_pt nil ) (repeat (if (zerop (vlax-get ename 'Closed)) (1+ (fix (vlax-curve-getEndParam ename))) (fix (vlax-curve-getEndParam ename))) (setq pt (vlax-curve-GetPointAtParam ename (setq pr (1+ pr))) lst_pt (cons pt lst_pt) ) ) (setq lst_z (mapcar 'caddr lst_pt) id_seg (- (length lst_z) (length (member (apply 'min lst_z) lst_z))) ) (setq nw_pt (vlax-invoke (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) ) 'AddPoint (nth id_seg lst_pt) ) ) (vla-put-Normal nw_pt (vlax-3d-point '(0 0 1))) ) (prin1) )

En même temps s'attaquer au DCL en ne maitrisant pas le lisp, cela va être ardu. Et en plus tu veux commencer par des list_box... Je ne peux te conseiller que de persévérer, (j'espère que tu as des cheveux!) ou revoir tes priorités.

Bonjour, Un exemple: Il te semblera peut être un peu complexe car il réunit le lisp et le dcl. En effet le lisp se charge d'écrire le DCL. En effet j'ai remarqué que les gens oubliaient souvent de joinde le DCL à leur lisp, résultat le code lisp ne fonctionne pas. Le code suivant permet de créer une boite de dialogue polyvalente, c'est à dire choisir une valeur dans une liste. (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun ListBox (title msg keylab flag / tmp file dcl_id choice) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "ListBox:dialog{label=\"" title "\";") file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{key=\"lst\";") (T "spacer;:list_box{key=\"lst\";multiple_select=true;") ) file ) (write-line "}spacer;ok_cancel;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "ListBox" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list (mapcar 'cdr keylab)) (end_list) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))) ) ) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) choice ) Exemple d'appel: ; définition de la liste (setq lst_col '(("1" . "coquelicot") ("4" . "ciel") ("3" . "sapin") ("6" . "bonbon"))) ; interrogation de la liste à travers le DCL (listbox "Table de couleur" "Choisir une couleur" lst_col 1) (Edition) Idée originale de (gile) que je me suis appropriée. (listbox "Table de couleur" "Choisir une couleur" lst_col 0) Présente la liste sous forme déroulante et retourne le choix effectué (listbox "Table de couleur" "Choisir une couleur" lst_col 1) Présente la liste (avec éventuellement ascenceur) et retourne le choix effectué (listbox "Table de couleur" "Choisir une couleur" lst_col 2) Présente la liste (avec éventuellement ascenceur) ET permet le choix multiple, retourne alors une liste des choix effectués.

Si tu en as vraiment beaucoup à faire... Autrement en adaptant rapidement un lisp que j'avais proposé, cela pourrait le faire (sachant qu'une automatisation ne vaut pas le ce qui est fait à la main) (defun c:dispatch_textoverid ( / js_mt nb_text inc_ang ang ent obj_vlax dxf_ent mnpt mxpt mintpt maxpt offset) (setq js_mt (ssget '((0 . "*TEXT")))) (cond (js_mt (cond ((> (setq nb_text (sslength js_mt)) 1) (setq inc_ang (/ (* 2 pi) nb_text) ang 0.0) (repeat nb_text (setq ent (ssname js_mt (setq nb_text (1- nb_text))) obj_vlax (vlax-ename->vla-object ent) dxf_ent (entget ent) pt_ins (cdr (assoc 10 dxf_ent)) ) (vla-GetBoundingBox obj_vlax 'mnpt 'mxpt) (setq minpt (trans (safearray-value mnpt) 0 1) maxpt (trans (safearray-value mxpt) 0 1) ) (setq offset (* (distance minpt maxpt) 2.0)) (entmod (subst (cons 10 (polar pt_ins ang offset)) (assoc 10 dxf_ent) dxf_ent)) (entmake (list '(0 . "LINE") '(8 . "NOEUD1") (cons 10 pt_ins) (cons 11 (polar pt_ins ang offset)) ) ) (setq ang (+ ang inc_ang)) ) ) ) ) ) ) Une fois cela fait, à l'aide d'un filtre rapide effacer tout tes encadrements de texte situés sur le calque NOEUD1 et les refaire à l'aide de ceci (defun transpts (apt matrix / ) (list (+ (* (car (nth 0 matrix)) (car apt)) (* (car (nth 1 matrix)) (cadr apt)) (* (car (nth 2 matrix)) (caddr apt)) (cadddr (nth 0 matrix)) ) (+ (* (cadr (nth 0 matrix)) (car apt)) (* (cadr (nth 1 matrix)) (cadr apt)) (* (cadr (nth 2 matrix)) (caddr apt)) (cadddr (nth 1 matrix)) ) (+ (* (caddr (nth 0 matrix)) (car apt)) (* (caddr (nth 1 matrix)) (cadr apt)) (* (caddr (nth 2 matrix)) (caddr apt)) (cadddr (nth 2 matrix)) ) ) ) (defun v_matr (dpt alphax alphay alphaz echx echy echz / ) (list (list (* echx (cos alphaz) (cos alphay)) (- (sin alphaz)) (sin alphay) (car dpt) ) (list (sin alphaz) (* echy (cos alphaz) (cos alphax)) (- (sin alphax)) (cadr dpt) ) (list (- (sin alphay)) (sin alphax) (* echz (cos alphax) (cos alphay)) (caddr dpt) ) (list 0.0 0.0 0.0 1.0) ) ) (defun c:box_text ( / js n ent_txt ins_point ht_txt lg_box ht_box ang_box pt_just lst_box transform diag_box sv_osm sv_cmd sv_blp cur_col mask_txt) (princ "\nChoix des MultiTEXTE ou TEXTE: ") (setq js (ssget '((0 . "*TEXT"))) n -1) (cond (js (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n))))) ; (while (null (setq ent_txt (nentsel "\nChoix d'un MultiTEXTE ou TEXTE: ")))) ; (setq dxf_ent (entget (car ent_txt))) (cond ((and (equal (assoc 210 dxf_ent) '(210 0.0 0.0 1.0)) (eq (cdr (assoc 0 dxf_ent)) "MTEXT")) (setq ins_point (cdr (assoc 10 dxf_ent)) ht_txt (/ (cdr (assoc 40 dxf_ent)) 5.0) lg_box (cdr (assoc 42 dxf_ent)) ht_box (cdr (assoc 43 dxf_ent)) ang_box (cdr (assoc 50 dxf_ent)) pt_just (cdr (assoc 71 dxf_ent)) ) (setq lst_box (list (list (- ht_txt) ht_txt 0.0) (list (+ lg_box ht_txt) ht_txt 0.0) (list (+ lg_box ht_txt) (- 0.0 ht_box ht_txt) 0.0) (list (- ht_txt) (- 0.0 ht_box ht_txt) 0.0) ) ) (cond ((eq pt_just 1) (setq transform (v_matr (list 0.0 0.0 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 2) (setq transform (v_matr (list (- (/ lg_box 2.0)) 0.0 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 3) (setq transform (v_matr (list (- lg_box) 0.0 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 4) (setq transform (v_matr (list 0.0 (+ (/ ht_box 2.0)) 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 5) (setq transform (v_matr (list (- (/ lg_box 2.0)) (/ ht_box 2.0) 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 6) (setq transform (v_matr (list (- lg_box) (/ ht_box 2.0) 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 7) (setq transform (v_matr (list 0.0 ht_box 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 8) (setq transform (v_matr (list (- (/ lg_box 2.0)) ht_box 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ((eq pt_just 9) (setq transform (v_matr (list (- lg_box) ht_box 0.0) 0.0 0.0 0.0 1.0 1.0 1.0)) ) ) (setq lst_box (mapcar '(lambda (x) (transpts x transform)) lst_box)) (setq transform (v_matr (trans ins_point 0 1) 0.0 0.0 (- ang_box) 1.0 1.0 1.0)) (setq lst_box (mapcar '(lambda (x) (transpts x transform)) lst_box)) ) ((or (and (equal (assoc 210 dxf_ent) '(210 0.0 0.0 1.0)) (eq (cdr (assoc 0 dxf_ent)) "TEXT")) (and (equal (assoc 210 dxf_ent) '(210 0.0 0.0 1.0)) (eq (cdr (assoc 0 dxf_ent)) "ATTRIB")) ) (setq diag_box (textbox dxf_ent) ins_point (cdr (assoc 10 dxf_ent)) ht_txt (/ (cdr (assoc 40 dxf_ent)) 5.0) ang_box (cdr (assoc 50 dxf_ent)) ) (setq lst_box (list (list (- (caar diag_box) ht_txt) (- (cadar diag_box) ht_txt) 0.0) (list (+ (caadr diag_box) ht_txt) (- (cadar diag_box) ht_txt) 0.0) (list (+ (caadr diag_box) ht_txt) (+ (cadadr diag_box) ht_txt) 0.0) (list (- (caar diag_box) ht_txt) (+ (cadadr diag_box) ht_txt) 0.0) ) ) (setq transform (v_matr ins_point 0.0 0.0 (- ang_box) 1.0 1.0 1.0)) (setq lst_box (mapcar '(lambda (x) (transpts x transform)) lst_box)) (setq lst_box (mapcar '(lambda (x) (trans x 0 1)) lst_box)) ) (T (princ "\nN'est pas un TEXTE/TEXTE MultiLigne, ou non parallèle au SCG.") (setq lst_box nil) ) ) (cond (lst_box (setq sv_osm (getvar "osmode") sv_cmd (getvar "cmdecho") sv_blp (getvar "blipmode") cur_col (getvar "CECOLOR") ) (setvar "cmdecho" 0) (setvar "blipmode" 0) (setvar "osmode" 0) (command "_.pline" (car lst_box) (cadr lst_box) (caddr lst_box) (cadddr lst_box) "_close") (setvar "cmdecho" sv_cmd) (setvar "blipmode" sv_blp) (setvar "osmode" sv_cmd) ) ) ) ) ) (princ) ) J'ai pas mieux à proposer rapidement

C'est que le style COURANT de multiligne est le même que celle des multiligne que tu essayes de changer... Effectivement les propriétés que je "pompe" ne concerne que le calque. Si cela convient, je pense qu'on pourra étendre facilement aux propriétés forcée d'échelle de type de ligne, de couleur, d'épaisseur de ligne, de type de ligne.

Bonjour, J'ai essayé vite fait un code pour redefinir les MLINE sélectionnées avec le style courant. (en fait elles sont retracées...) Je l'ai pas testé en profondeur, donc méfiance. Ce qui m'a surpris c'est que je n'ai pas trouvé où est l'option fermée en activeX, donc j'ai traité celle-ci avec les code DXF. Voilà pour le brouillon à essayer. (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (vl-load-com) (defun c:redef_mline ( / jsml AcDoc Space UCS save_ucs WCS nbr ent_name ename l_pt id_obj) (setq jsml (ssget '((0 . "MLINE"))) ) (cond (jsml (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) UCS (vla-get-UserCoordinateSystems AcDoc) save_ucs (vla-add UCS (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (getvar "UCSXDIR")) (vlax-3d-point (getvar "UCSYDIR")) "CURRENT_UCS" ) ) (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG"))) (vla-StartUndoMark AcDoc) (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS")) (vla-put-activeUCS AcDoc WCS) (repeat (setq nbr (sslength jsml)) (setq ent_name (ssname jsml (setq nbr (1- nbr))) drap (assoc 71 (entget ent_name)) ename (vlax-ename->vla-object ent_name) id_obj (vla-get-ObjectName ename) ) (cond ((eq id_obj "AcDbMline") (setq l_pt (l-coor2l-pt (vlax-get ename 'Coordinates) T)) (setq nw_ml (vlax-invoke Space 'AddMline (apply 'append l_pt))) (vla-put-Layer nw_ml (vla-get-Layer ename)) (entmod (subst drap (assoc 71 (entget (entlast))) (entget (entlast)))) (vla-delete ename) ) ) ) (and save_ucs (vla-put-activeUCS AcDoc save_ucs)) (and WCS (vla-delete WCS) (setq WCS nil)) (vla-EndUndoMark AcDoc) ) ) (prin1) )

Bonjour, Alors je vais compléter le mien. RESTRICTIONS: NE COPIE PAS les données empilées. (seul le premier enregistrement est lu) (defun c:break_lw@vtx_withOD ( / js i ent dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef ) (initget "Toutes Sélection _All Select") (if (eq (getkword "\nLWPolylignes à couper à chaque sommets? [Toutes/Sélection] <Sélection>: ") "All") (setq js (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) i -1 ) (setq js (ssget (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) i -1 ) ) (cond (js (repeat (sslength js) (setq dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))) (list "*")) xd_l (assoc -3 dxf_obj) ) (if (cdr (assoc 43 dxf_obj)) (setq dxf_43 (cdr (assoc 43 dxf_obj))) (setq dxf_43 0.0) ) (if (cdr (assoc 38 dxf_obj)) (setq dxf_38 (cdr (assoc 38 dxf_obj))) (setq dxf_38 0.0) ) (if (cdr (assoc 39 dxf_obj)) (setq dxf_39 (cdr (assoc 39 dxf_obj))) (setq dxf_39 0.0) ) (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj)) dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj)) dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj)) dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj)) dxf_210 (cdr (assoc 210 dxf_obj)) ) (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1))) (setq dxf_10 (append dxf_10 (list (car dxf_10))) dxf_40 (append dxf_40 (list (car dxf_40))) dxf_41 (append dxf_41 (list (car dxf_41))) dxf_42 (append dxf_42 (list (car dxf_42))) n (cdr (assoc 90 dxf_obj)) ) (setq n (1- (cdr (assoc 90 dxf_obj)))) ) (repeat n (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (assoc 8 dxf_obj) (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256)) (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER")) (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1)) (cons 100 "AcDbPolyline") (cons 90 2) (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128)) (cons 38 dxf_38) (cons 39 dxf_39) (cons 10 (car dxf_10)) (cons 40 (car dxf_40)) (cons 41 (car dxf_41)) (cons 42 (car dxf_42)) (cons 10 (cadr dxf_10)) (cons 40 (cadr dxf_40)) (cons 41 (cadr dxf_41)) (cons 42 (cadr dxf_42)) (assoc 210 dxf_obj) ) (if xd_l (list xd_l) '()) ) ) (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) lst_data nil nwent (entlast)) (if (or (numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object)))) (numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object)))) ) (progn (foreach n (ade_odgettables ent) (setq tbldef (ade_odtabledefn n)) (setq lst_data (cons (mapcar '(lambda (fld / tmp_rec numrec) (setq numrec (ade_odrecordqty ent n)) (cons n (while (not (zerop numrec)) (setq numrec (1- numrec)) (if (zerop numrec) (if tmp_rec (cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec))) (cons fld (ade_odgetfield ent n fld numrec)) ) (setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec)) ) ) ) ) (mapcar 'cdar (cdaddr tbldef)) ) lst_data ) ) ) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (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 ) ) ) ) ) ) (entdel ent) ) (print (sslength js)) (princ " LWpolyligne(s) coupée(s) à ses sommets avec ses Object Datas.") ) ) (prin1) ) EDIT du 14-05-19: lève la restriction sur les N records

Salut, Si je me rappelle bien, j'avais eu ce problème souS Autocad 2009 pour convertir du cadastre de LIIe en L93 avec Covadis. Ayant eu un Autocad Map peu après, j'avais fais la conversion avec celui-ci, et avec lui pas de problème; les blocs étaient reprojetés. PS: Pas regardé ton fichier, surbooké...

Bonjour, Remettre la variable PICKBOX à 0 ? (la valeur par défaut est 3)

Bonjour, Comme on pouvait le penser,il n'y a aucune données SIG dans ce DWG, donc le BDF sera pauvre. Néamoins j'ai quand même attribué des propriétés géométriques: Surface, Longueur/Périmètre et les XYZ/attributs de bloc pour les points. En espérant que cela convienne...EKuh6nPP7Kz_G-46-101-A.zip

Bonjour, Pour l'angle de rotation du bloc, en repartant du code de Patrick_35, on pourrait essayé ceci: (defun c:blp ( / n nom nb ent vlaobj lst) (if (setq nom (getstring "\nNom du bloc : ")) (if (tblsearch "block" nom) (progn (princ "\nSélection de la polyligne") (setq nb 0 ent (car (entsel)) vlaobj (vlax-ename->vla-object ent)) (foreach n (setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (entmake (list (cons 0 "INSERT") (cons 2 nom) (cons 10 n) (cons 41 1) ; facteur echelle X = 1 (cons 42 1) ; facteur echelle Y = 1 (cons 43 1) ; facteur echelle Z = 1 (cons 50 (if (and (not (zerop nb)) (not (eq (1+ nb) (length lst)))) (+ (* pi 0.5) (* 0.5 (+ (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (1- nb))) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nb)) ))) (- (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nb)) (* pi 0.5)) ) ) )) (setq nb (1+ nb )) ) ) (princ (strcat "\nBloc " nom " inconnu")) ) ) (princ) ) Pour les attributs cela devient plus compliqué à gérer si le nom du bloc est libre. (il faut savoir le nombre d'attributs à renseigner pou celui-ci) ICI, il y a un exemple de code pour un bloc bien précis (determiné dans le lisp), qui renseigne les attributs.

C'est un bête copier-collé de code à code qui est resté depuis que je me suis penché sur la syntaxe des champs. A l'époque je l'avais obtenue comme dit ICI Un AcObjProp Object fonctionne tout aussi bien. Il faut croire que les deux syntaxes fonctionnent (certainement pour la compatibilité des anciennes syntaxes) Te l'expliquer j'en serais bien incapable, c'est la soupe interne d'Autodesk... je laisse la main.

C'est bien une erreur de syntaxe de ma part; il manquait un ">%" à la fin. La correction, pour ceux que ça pourrait interesser... (defun c:field_ptUCS ( / AcDoc Space pt obj nw_obj) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-AddPoint Space (vlax-3d-point (setq pt (trans (getpoint "\nPoint?: ") 1 0)))) (setq obj (entlast)) (setq nw_obj (vla-addMtext Space (vlax-3d-point pt) 0.0 (strcat "%<\\AcExpr (w2u(" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%).Coordinates >%))>%" ) ) ) (prin1) )

Relis mon message du dessus (que j'avais modifié) Il faut que tu fasse une conversion de radian en degré Si l'origine des angles est à l'Est et que ton sens de rotation des angles est dans le sens trigo, tu n'a rien d'autre à faire. (setq lg (* 0.9 (cdr (assoc 50 (entget ent))))) doit devenir (setq lg (* 180.0 (/ (cdr (assoc 50 (entget ent))) pi))) comme l'avait souligné patrick_35

(assoc 50 ent) Tu as soumis un non d'entité à (assoc), ce n'est pas ce qu'il attend (d'ou le retour d'erreur: type d'argument incorrect: listp <Nom d'entité: 7ffffb2e590>) Assoc attend une liste pour extraire de celle ci le code associé. cette liste de définition tu l'obtiens avec (enget <le nom de l'entité>) donc; (assoc 50 (entget ent)) devrait aller beaucoup mieux... ATTENTION: la valeur retournée par (assoc 50)est une TOUJOURS une valeur en RADIAN. (quelque soit le système utilisé dans ton dessin). L'origine est toujours l'axe des X (Est) et la rotation dans le sens mathématique. Donc fais la conversion adéquate radians vers système souhaité.

Une version un peu similaire pour écrire une OD sur une entité curviligne (elle est encore embryonnaire). (vl-load-com) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun ListBox (title msg keylab flag / tmp file dcl_id choice) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "ListBox:dialog{label=\"" title "\";") file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{key=\"lst\";") (T "spacer;:list_box{key=\"lst\";multiple_select=true;") ) file ) (write-line "}spacer;ok_cancel;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "ListBox" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list (mapcar 'cdr keylab)) (end_list) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))) ) ) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) choice ) (defun c:OD2Label_Side ( / js obj ename htx AcDoc Space nw_style lst_tabl_def inc_key lst_def desc_od desc_tbl str msg pt deriv rtx nw_obj dxf_ent tmp) (princ "\nSélectionnez une polyligne.") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet valable pour cette fonction!") ) (setq obj (ssname js 0) ename (vlax-ename->vla-object obj) ) (cond ((ade_odgettables obj) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Label")) (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96) ) ) (cond ((null (tblsearch "STYLE" "Romand-Label")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (setq lst_tabl_def (mapcar 'ade_odtabledefn (ade_odgettables obj)) inc_key 0) (foreach n lst_tabl_def (foreach el n (if (listp (cdr el)) (foreach sel (cdr el) (foreach msel sel (if (eq (car msel) "ColName") (setq lst_def (cons (cons (strcat "key" (itoa (setq inc_key (1+ inc_key)))) (cdr msel)) lst_def)) ) ) ) ) ) ) (if (not desc_od) (setq desc_od (cdr (assoc (listbox "Donnée d'objet" "Choisir une données d'objet" lst_def 1) lst_def)) desc_tbl nil) ) (foreach n lst_tabl_def (if (assoc (cons "ColName" desc_od) (cdaddr n)) (setq desc_tbl (cdar n)) ) ) (cond (desc_tbl (setq str (ade_odgetfield obj desc_tbl desc_od 0)) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE")))) (setq rtx 0.0) (cond ((eq (type str) 'INT) (itoa str)) ((eq (type str) 'REAL) (rtos str 2 2)) ((eq (type str) 'STR) str) (T "") ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx) ) (setq dxf_ent (entget (entlast))) (while (or (= 5 (car (setq tmp (grread t 5 1)))) (/= (car tmp) 25) (= (car tmp) 3)) (cond ((= 5 (car tmp)) (setq pt (vlax-curve-getClosestPointTo ename (trans (cadr tmp) 1 0)) deriv (vlax-curve-getFirstDeriv ename (vlax-curve-GetParamAtPoint ename pt)) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (entmod (subst (cons 50 rtx) (assoc 50 dxf_ent) (subst (cons 10 (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))) (assoc 10 dxf_ent) dxf_ent) ) ) (entupd (cdar dxf_ent)) ) ((= 3 (car tmp)) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE")))) (setq rtx 0.0) (cond ((eq (type str) 'INT) (itoa str)) ((eq (type str) 'REAL) (rtos str 2 2)) ((eq (type str) 'STR) str) (T "") ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx) ) (setq dxf_ent (entget (entlast))) ) (T (princ "\nArrêt anormal de la commande ")) ) ) ) ) (entdel (entlast)) ) (T (princ "\nPas de données d'objet attachées")) ) (prin1) )

Bonjour, Une erreur sur le filtre ssget: ce n'est pas LWPOLYLIGNE mais LWPOLYLINE Je ne comprend pas pourquoi tu fais appel à (entsel) distance entre 10 et 11 est valable pour une ligne, mais pas une polyligne. Essayes avec cette syntaxe? pas testé... ((lambda ( / js ent lg) (setq js (ssget '((0 . "LWPOLYLINE") (8 . "AEP_TRONCON")))) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n)))) (setq lg (vlax-curve-getDistAtPoint ent (vlax-curve-getEndPoint ent))) (ade_odsetfield ent "TRONCON" "LONGUEUR" 0 lg) ) ))

Brièvement, NON. La seule possibilité qu'il y a, est d'avoir une valeur d'attribut par défaut lors de la définition. Pratique si la valeur revient souvent, mais une liste de valeur...

Bonjour, C'est tout à fait faisable avec la commande Ligne en standard. Il suffit (en faisant quand même attention aux accroches objets) de travailler avec les coordonnées absolues. Exemple C'est l'astérique (*) qui force à travailler en coordonnées absolue Cela dessinera une ligne du point 555,666 depuis le SCG avec une longueur de 600 horizontale avec n'importe quel SCU.