bonuscad

Salut, Je ne sais pas si c'est ce que tu désire, mais si tu fais un click-droit sur la présentation (Sheet1) et que tu sélectionne "Exporter présentation en objet..." il va créer un nouveau dessin avec cet objet. Ce sera un bloc que tu pourra décomposer et retrouver ainsi les entités primaires.

Salut, Essayes ceci, tu copie-colle le code directement en ligne de commande. La couleur n'est pas aléatoire mais incrémenté. Je suis parti de la couleur 0 : donc 1 (rouge), tu peux partir de 10 si tu le désire. ((lambda ( / flag col def_lay nam_lay dxf_lay) (setq flag T col 0) (while (setq def_lay (tblnext "LAYER" flag)) (setq nam_lay (cdr (assoc 2 def_lay)) flag nil) (if (wcmatch nam_lay "z-usine-*") (progn (setq dxf_lay (entget (tblobjname "LAYER" nam_lay))) (entmod (subst (cons 62 (setq col (1+ col))) (assoc 62 dxf_lay) dxf_lay)) ) ) ) (prin1) ))

Et toujours dans les XData en complément, une fonction pour lire les données attachées; similaire à xdlist des expresstools, mais les données sont lues en dynamique dès le survol d'une entité ayant des données étendues (plus pratique à mon goût que de relancer xdlist à chaque fois et refaire une sélection). Seule restriction lors de l'usage, NE PAS UTILISER "Esc/Echap": c'est la seule touche qui ne peut être gérée avec (grread), toutes autres touches ou action de clic sur la souris mettra fin à la fonction. Si vous le faites vous aurez un MText ajouté dans votre dessin qu'il faudra supprimer par vous même... (vl-load-com) (defun c:dyn_read_xdata ( / AcDoc Space UCS save_ucs WCS nw_obj ent_text dxf_ent apps lst_apps data ncol strcatlst Input obj_sel ename) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (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"))) (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) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 "" ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (/ (getvar "VIEWSIZE") 100.0) 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 176) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 254) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq Input (grread T 4 2)) (= (car Input) 5)) (cond ((setq obj_sel (nentselp (cadr Input))) (if (eq (type (car (last obj_sel))) 'ENAME) (if (member (cdr (assoc 0 (entget (car (last obj_sel))))) '("INSERT" "ACAD_TABLE" "DIMENSION")) (if (or (eq (cdr (assoc 0 (entget (car (last obj_sel))))) "ACAD_TABLE") (not (eq (boole 1 (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car (last obj_sel)))))))) 4) 4)) ) (setq obj_sel (cons (car (last obj_sel)) '((0.0 0.0 0.0)))) ) ) ) (setq dxf_ent (entget (car obj_sel) (list "*")) ) (if (eq (cdr (assoc 0 dxf_ent)) "VERTEX") (progn (while (eq (cdr (assoc 0 dxf_ent)) "VERTEX") (setq dxf_ent (entget (entnext (cdar dxf_ent)))) ) (setq dxf_ent (entget (cdr (assoc -2 dxf_ent)) (list "*"))) ) ) (setq apps (cdr (assoc -3 dxf_ent)) ncol 0 lst_apps nil ) (if apps (foreach el apps (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps))) ) ) (if lst_apps (foreach xd lst_apps (setq data (assoc xd apps) strcatlst (strcat (if strcatlst strcatlst "") (apply 'strcat (mapcar '(lambda (x) (if (listp x) (strcat "(" (itoa (car x)) " . " (cond ((eq (car x) 1002) (strcat (if (eq (cdr x) "{") "\"(\"" "\")\""))) ((member (car x) '(1000 1003 1004 1005)) (strcat "\"" (cdr x) "\"")) ((member (car x) '(1040 1041 1042)) (rtos (cdr x))) ((member (car x) '(1070 1071)) (itoa (cdr x))) ((member (car x) '(1010 1011 1012 1013 1020 1021 1022 1023 1030 1031 1032 1033)) (strcat "(" (rtos (cadr x)) "," (rtos (caddr x)) "," (rtos (cadddr x)) ")")) ) ")\\P" ) (strcat "{\\C" (itoa (setq ncol (+ 10 ncol))) " " (car data)"}" "\\P") ) ) data ) ) ) ) ) ) (if strcatlst (progn (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'InsertionPoint 'Height 'TextString) (list (mapcar '- (getvar "VIEWCTR") (list (* (getvar "VIEWSIZE") 0.5) (- (* (getvar "VIEWSIZE") 0.5)) 0.0)) (/ (getvar "VIEWSIZE") 100.0) (strcat "{\\fArial;" strcatlst "}" )) ) ) (vlax-put nw_obj 'TextString "") ) (setq strcatlst nil) ) (T (vlax-put nw_obj 'TextString "")) ) ) (vla-Delete nw_obj) (and save_ucs (vla-put-activeUCS AcDoc save_ucs)) (and WCS (vla-delete WCS) (setq WCS nil)) (prin1) ) NB: La fonction fonctionne aussi sur les xrefs. Vous pouvez avoir les information des objets imbriqués sans ouvrir le dessin constituant l'Xref.

Suite à des dysfonctionnements observé par Alexander, j'ai revu le code. J'ai abandonné l'usage de (entdel) et (entmake) pour utiliser essentiellement (entmod) qui se révèle plus fiable. J'ai modifié le 1er post.

Bonjour, Je peux te proposer ceci (un lisp destiné à l'origine pour les longueurs et rapidement adapté pour les surfaces), je pense que ça peut être un bon départ... Donc je pense que tu sera capable de faire les petits ajustements à ta convenance, si nécessaire. (vl-load-com) (defun make_mlead (pt obj / ptlst arr nw_obj) (setq ptlst (append pt (polar pt o_lead d_lead)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (if (not inc) (setq inc -1)) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "{\\fArial|b0|i0|c0|p34;" (itoa (setq inc (1+ inc))) "\\P" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID obj)) ">%).Area \\f \"%lu2%pr2%ps[,m²]\">%}" ) ) (vla-put-layer nw_obj (getvar "CLAYER")) (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car (getvar "VIEWCTR")) (car pt_lead)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) (vla-update nw_obj) ) (defun c:num&area2lead ( / js htx rtx rtx0 pt_lead d_lead o_lead AcDoc Space n ename pt) (princ "\nSélectionner les polylignes/hachures à mesurer") (while (null (setq js (ssget (list '(0 . "*POLYLINE") '(-4 . "<AND") '(-4 . "<NOT") '(-4 . "&") '(70 . 120) '(-4 . "NOT>") '(-4 . "&") '(70 . 1) '(-4 . "AND>") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ))))) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nDonner la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nDonner l'orientation du champ <0.0>: "))) (setq rtx 0.0)) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx)) (initget 1) (setq pt_lead (getpoint (getvar "VIEWCTR") "\nDonner l'orientation générale et la distance de la ligne de guidage: ")) (setq d_lead (distance (getvar "VIEWCTR") pt_lead)) (setq o_lead (angle (getvar "VIEWCTR") pt_lead)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (repeat (setq n (sslength js)) (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))) pt (vlax-curve-getPointAtParam ename (* (- (vlax-curve-getEndParam ename) (vlax-curve-getStartParam ename)) 0.5)) ) (make_mlead pt ename) ) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) (prin1) )

En effet, ce qui prouve que je n'avais pas trop testé...😕 Je pense que dès qu'une XRef est rechargée dans le dessin le nom de l'entité xref change et on perd les petits! Peut être qu'avec le "Handle" de l'xref on pourrait retrouvé celui-ci, mais il faudrait stocké celui-ci quelque part et écrire une procédure spéciale pour mettre à jours ces champs imbriqués. J'avoue que cela devient compliqué, le jeu en vaut-il la chandelle? Et pas sur que ça fonctionne au final.

Essaye peut être avec ceci, pas trop testé... (vl-load-com) (defun make_mlead (pt l_e / pt_lead d_lead o_lead arr l_str obj nw_obj) (initget 9) (setq pt_lead (getpoint pt "\nDonner l'orientation et la distance de la ligne de guidage: ") d_lead (distance pt pt_lead) o_lead (angle pt pt_lead) ptlst (append pt (polar pt o_lead d_lead)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) l_str "" ) (while l_e (setq obj (vlax-ename->vla-object (car l_e)) l_str (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID obj)) ">%).TextString>%" "\\P" l_str ) l_e (cdr l_e) ) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "{\\fArial|b0|i0|c0|p34;" l_str "}" ) ) (vla-put-layer nw_obj (getvar "CLAYER")) (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car (getvar "VIEWCTR")) (car pt_lead)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) (vla-update nw_obj) ) (defun c:nested_text2lead ( / htx rtx rtx0 ent lst_e AcDoc Space n ename pt) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nDonner la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nDonner l'orientation du champ <0.0>: "))) (setq rtx 0.0)) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx)) (while (setq ent (car (nentsel "\nChoix d'un texte: "))) (if (member (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT" "ATTRIB")) (setq lst_e (cons ent lst_e)) ) ) (cond (lst_e (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (initget 9) (setq pt (getpoint "\nPoint de départ de la ligne de rappel: ")) (make_mlead pt lst_e) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) ) ) (prin1) )

Bonjour, J'ai un membre (russe:alexander) d'un forum autodesk (surtout autocad map) qui me sollicite assez souvent pour améliorer des routines: il a toujours des remarques fondées et des suggestions pour rendre l'application fonctionnelle à bon nombres d'utilisateurs. Sa dernière demande concernait les Xdata (donc version classique ou Map) Il désirait pouvoir effacer certaines application XData et en garder d'autres. Ce qui m'a valu de pondre une version générique de cette fonction (avec une fonction:listbox que j'utilise beaucoup: un grand merci à gilles Chanteau) Voici le code que j'ai transmit à Alexander, qu'il pourra éventuellement publier aussi sur son site. ;; ListBox (gile) ;; Boite de dialogue permettant un ou plusieurs choix dans une liste ;; ;; Arguments ;; title : le titre de la boite de dialogue (chaîne) ;; msg ; message (chaîne), "" ou nil pour aucun ;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...) ;; flag : 0 = liste déroulante ;; 1 = liste choix unique ;; 2 = liste choix multipes ;; ;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2) ;; ;; Exemple d'utilisation ;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1) (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\";width=32;") (T "spacer;:list_box{key=\"lst\";width=32;multiple_select=true;") ) file ) (write-line "}ok_cancel_err;}" 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:remove_Xdata ( / js n ent_name dxf_ent apps lst_apps sel_app) (princ "\nSélectionner les objets auxquels retirer des XData.") ; (or (setq js (ssget "_I" '((-3 ("*"))))) ; (setq js (ssget "_P" '((-3 ("*"))))) ; ) (cond ((null js) (initget "Selection Tout _Select All") (if (eq (getkword "\nTraiter un jeu de [Selection/Tout] <Selection>: ") "All") (setq js (ssadd) js (ssget "_X" '((-4 . "<AND") (-4 . "<NOT") (-3 ("ACAD")) (-4 . "NOT>") (-3 ("*")) (-4 . "AND>")))) (setq js (ssadd) js (ssget '((-4 . "<AND") (-4 . "<NOT") (-3 ("ACAD")) (-4 . "NOT>") (-3 ("*")) (-4 . "AND>")))) ) ) ) (cond (js (sssetfirst nil js) (repeat (setq n (sslength js)) (setq ent_name (ssname js (setq n (1- n))) dxf_ent (entget ent_name (list "*")) apps (cdr (assoc -3 dxf_ent)) ) (foreach el apps (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps))) ) ) (setq lst_apps (vl-remove "ACAD" (vl-sort lst_apps '<))) (if lst_apps (setq sel_app (listbox "Applications" "Choisir l'application" (mapcar 'cons lst_apps lst_apps) 2)) (setq lst_apps nil) ) (cond (sel_app (setq js (ssget "_P" (list (list -3 (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app))))))) (cond (js (repeat (setq n (sslength js)) (setq ent_name (ssname js (setq n (1- n))) dxf_ent (entget ent_name '("*")) ) (foreach el sel_app (entmod (list (cons -1 ent_name) (list -3 (list el)))) ) ) (princ (strcat "\nLes applications " (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)) " ont été supprimées pour " (itoa (sslength js)) " objets.")) ) (T (princ "\nPas d'applications corespondantes trouvée")) ) ) (T (princ "\nAucune application trouvée dans la sélection.")) ) ) ) (prin1) ) Édité pour amélioration de la sélection qui n'est plus tous les objets, tri alphabétique des applications dans la boite de dialogue...

Déjà il n'y a pas eu de refus sur la syntaxe et cela a fait quelque chose. Mais je ne pourrais guère plus t'aider; essayer d'autre syntaxe ? 'OR au lieu de "OR" Ou scinder la demande en deux... (or (AfmHighltQuerySetFIlter (list (list "tableName.fieldName" "value"))) (AfmHighltQuerySetFIlter (list (list "tableName.fieldName" "value"))) ) Après je n'ai plus d'idée...

Alors par rapport à la doc en ligne et en faisant la corrélation avec AutocadMap, je serais tenté de proposer ceci, sans aucune certitude. (AfmHighltQuerySetFIlter (list "OR" (list "tableName.fieldName" "value") (list "tableName.fieldName" "value")))

Bonjour, Sans du tout connaître ArchiBus, en voyant le nom des fonctions (AfmHighltQuery....), cela me fait penser à des fonctions de requêtes (comme AutocadMap) Il faudrait connaître la syntaxe exacte pour les appels faites par ces fonctions (Tu n'as pas de doc?) Je pense qu'il faudrait employer simplement un "OR" dans l'appel mais je ne peut te proposer une syntaxe à employer. Est ce que ArchiBus te permet de monter des requêtes manuellement? Çà pourrait aider pour savoir la syntaxe à utiliser...

Des côtes linéaires: longueur d'arc ou de segment droits de (n) LWPOLYLINE séléctionnées (polylignes légères) (vl-load-com) (defun c:Dim_PolyArc ( / js AcDoc n ename obj pr pt_sel seg_bulge deriv alpha pt_dim) (princ "\nSélectionner une polyligne.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nPas de LWPolyLines sélectionnées!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-StartUndoMark AcDoc) (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ename) pr -0.5 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq pt_sel (vlax-curve-GetPointAtParam obj (setq pr (1+ pr))) seg_bulge (vla-GetBulge obj (- pr 0.5)) deriv (vlax-curve-getFirstDeriv obj pr) alpha (- (atan (cadr deriv) (car deriv)) (* pi 0.5)) pt_dim (polar pt_sel alpha (* 2.0 (getvar "DIMTXT"))) ) (if (not (zerop seg_bulge)) (command "_.dimarc" "_none" (trans pt_sel 0 1) "_none" (trans pt_dim 0 1)) (command "_.dimaligned" "_none" (trans (vlax-curve-GetPointAtParam obj (- pr 0.5)) 0 1) "_none" (trans (vlax-curve-GetPointAtParam obj (+ pr 0.5)) 0 1) "_none" (trans pt_dim 0 1) ) ) ) ) (vla-EndUndoMark AcDoc) (prin1) )

Certainement un problème de codage du fichier. Dans ton éditeur en récupérant en copié-collé depuis un navigateur internet tu l'a certainement récupéré en UFT-8, il faudrait le basculer en ANSI. Notepad3 permet de faire cela aisément ...

Ça y est étant à la retraite (pour l'instant en congé) Mes collègues étant en difficulté avec mon application (il n'arrivaient pas à avoir le numéro des parcelles), j'ai donc réalisé une vidéo pour leur expliquer la procédure. Comme elle est faite je la mets ici, ça fera un plus... et pourra peut être aider ! BD_CADASTRE

Et oui et c'est pour ça que sous LT on ne peut qu'utiliser que ces variable userSx et pas userIx ou userRx dans les macros diesel. Le diesel ne comprend que les chaines (String), ce qui je pense explique cette différence d'enregistrement dans le dessin

Traduire ?! toute la formule est là (setq E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2))) E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2))) E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2))) E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1)) Z (- (- (* (/ E2 E1) (car pt))) (* (/ E3 E1) (cadr pt)) (/ E4 E1)) ) donc 4 variable E1 à E4 calculées avec le XYZ des 3 points X1 Y1 Z1 ,...., qui au final donne le Z du point cliqué: (car pt) et (cadr pt) étant le X Y de ce point avec Z recherché!

Une possibilité, poser une borne avant l'action: (setq borne (entlast)) Et après l'action , récupérer toutes les entités crées depuis la borne posée: (if (and borne (entget borne))(progn (setq ss nil ss(ssadd))(while (setq Suivant (entnext Borne))(ssadd Suivant ss)(setq Borne Suivant))ss))

Une procédure en lisp pour interpoler le z d'un point quelconque avec un plan défini par 3 points, le point peut être situé dans ou en dehors du triangle. ((lambda ( / pt lst_pt n X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 E1 E2 E3 E4 Z) (repeat 3 (initget 9) (if lst_pt (setq pt (getpoint pt "\nPoint suivant: ")) (setq pt (getpoint "\nPremier point: ")) ) (setq lst_pt (cons pt lst_pt)) ) (initget 9) (setq pt (getpoint "\nDonnez le point à interpoler: ") n 0) (foreach item '(("X" . "'car") ("Y" . "'cadr") ("Z" . "'caddr")) (mapcar '(lambda (x) (set (read (strcat (car item) (itoa (setq n (1+ n))))) x)) (mapcar (eval (read (cdr item))) lst_pt) ) (setq n 0) ) (setq E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2))) E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2))) E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2))) E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1)) Z (- (- (* (/ E2 E1) (car pt))) (* (/ E3 E1) (cadr pt)) (/ E4 E1)) ) (command "_.point" "_none" (list (car pt) (cadr pt) Z)) (print (rtos Z)) (prin1) ))

Merci, Pour enlever le S=, c'est assez simple à la ligne 69 tu retires "S=" et à la ligne 103 tu retires S= (en laissant bien le "[" et la "," avant et après) Pour le calque courant, c'est déjà le cas ?!? Mais peut être ce qui te perturbe est la couleur forcée du texte qui n'est pas "ducalque" Si c'est cela, change simple à la ligne 77 le dernier nombre entier fourni 250 en 256 (pour "bylayer")

Bonjour, Est ce un fichier qui vous a été donné par e-transmit (fichier.zip)? Si oui, que contenait-il? Tu l'as dézippé intégralement? des fichiers AutoCAD.lsp acaddoc.lsp acaddoc20xx.lsp ou encore d'un .mnl ou *.vlx En attendant ta réponse pour partir en exploration et si possible le fichier incriminé...

J'ai donc amélioré le lisp proposé dans ce fil. Il permet dorénavant de choisir son unité de départ supposé du dessin, de faire une conversion du résultat dans une autre unité et de choisir la précision du résultat. Par exemple on a réalisé un dessin en mm mais on souhaite avoir le résultat de la surface en cm² (sans changer l'unité de départ) avec une précision de 6 chiffres après la virgule. Ces paramètres restent valables tant qu'on reste dans la boucle du choix d'un objet fermé, si on relance la procédure il faudra redéfinir les options. Je suis resté dans le système métrique uniquement. (vl-load-com) (defun c:surf_curve-closed ( / AcDoc Space unite u_source u_target factor prec js nw_obj ename ent_text dxf_ent key) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (initget "KM M CM MM") (setq unite (getkword "\nChoisir l'unité source utilisé dans le dessin [KM/M/CM/MM] <M>: ")) (if (not unite) (setq unite "M")) (setq u_source (cond ((eq unite "KM") "sq_km") ((eq unite "M") "sq_m") ((eq unite "CM") "sq_cm") ((eq unite "MM") "sq_mm") ) ) (initget "KM M CM MM") (setq unite (getkword "\nChoisir l'unité cible à utiliser pour le résultat [KM/M/CM/MM] <M>: ")) (if (not unite) (setq unite "M")) (setq u_target (cond ((eq unite "KM") "sq_km") ((eq unite "M") "sq_m") ((eq unite "CM") "sq_cm") ((eq unite "MM") "sq_mm") ) ) (setq factor (cvunit 1 u_source u_target)) (initget "0 1 2 3 4 5 6 7 8") (setq prec (getkword "\nPrécision du résultat [0/1/2/3/4/5/6/7/8] <2>: ")) (if (not prec) (setq prec "2")) (princ "\nSélectionnez un objet fermé") (while (setq js (ssget "_+.:E:S" '( (-4 . "<OR") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "AND>") (0 . "CIRCLE") (-4 . "<AND") (0 . "SPLINE") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "ELLIPSE") (41 . 0.0) (42 . 6.283185307179586) (-4 . "AND>") (-4 . "OR>") ) ) ) (if (zerop (getvar "USERR1")) (setvar "USERR1" (/ (getvar "VIEWSIZE") 75.0))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 (strcat "S="(rtos (* factor (vlax-get-property (setq ename (vlax-ename->vla-object (ssname js 0))) "Area")) 2 (atoi prec)) (strcase unite T) "²") ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (getvar "USERR1") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 250) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) (vlax-put (vlax-ename->vla-object (entlast)) 'TextString (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr" prec "%ps[S=," (strcase unite T) "²]\%ct8[" (rtos factor 2 12) "]\">%" ) ) ) (prin1) )

Bonjour, J'avais répondu à une demande en 2013 faite avec les fonctions vlax-curve. Si tu veux jeté un coup d’œil, c'est là: Supprimer un sommet de polyligne en créant un arc

lili2006, je ne sais pas à quelle routine tu fais allusion, j'en ai publié tant et plus... Celle que je pense serait celle-ci, bien qu'elle fasse le cumul (en aire ou longueur), elle peut être utilisée pour un objet unique.

Exact Olivier, mais il demande une certaine dextérité, dans un dessin un peu fouillis, on a vite fait de ce se retrouver avec plusieurs source de parallèles sans s'en rendre forcément compte. Moi personnellement je le trouve pas forcément productif, un peu comme le mode "tracking", j'ai du mal à mis faire. Certe cela fonctionne mais dès que tu loupe une étape, ça foire vite, mais sa reste mon avis.

En pur lisp (vanilla), c'est certainement le moins efficient (surtout avec de nombreux sommets) Ça retourne les coordonnées dans le SCG quel que soit le SCU de conception et l'élévation. ((lambda ( / ent dxf_ent) (cond ((setq ent (entsel)) (setq ent (car ent) dxf_ent (entget ent)) (mapcar '(lambda (z) (trans (list (car z) (cadr z) (cdr (assoc 38 dxf_ent))) (cdr (assoc 210 dxf_ent)) 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) ) ) ))