Classement

Bonjour, Une autre proposition (avec les champs; un point est créé...) (defun c:coord-xy_field ( / AcDoc Space pt_pos pt_field htx rtx rtx0 ncol obj js nw_obj l_max p1 p2 p3) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (while (setq pt_pos (getpoint "\nPosition à repérer?: ")) (initget 9) (setq pt_field (getpoint pt_pos "\nEmplacement du texte?: ")) (initget 6) (setq htx (getdist pt_field (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient pt_field "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0)) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx) ncol '(96 2)) (foreach n '("Id-XY" "Id-Point") (cond ((null (tblsearch "LAYER" n)) (vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol)) ) ) (setq ncol (cdr ncol)) ) (cond ((null (tblsearch "STYLE" "Romand-Field")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field")) (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) ) ) ) (vlax-put (vla-AddPoint Space (vlax-3d-point pt_pos)) 'layer "Id-Point") (setq obj (entlast) js (ssadd)) (mapcar '(lambda (lx) (apply '(lambda (ins_point value_field att_point txt_height dwg_dir name_style name_layer txt_rot / nw_obj) (setq nw_obj (vla-addMtext Space (vlax-3d-point ins_point) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) value_field ) ) js (ssadd (entlast) js) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list att_point txt_height dwg_dir ins_point name_style name_layer txt_rot) ) ) lx ) ) (list (list (mapcar '+ pt_field (list (- (* (getvar "TEXTSIZE") (cos rtx0)) (* (* (getvar "TEXTSIZE") 0.5) (sin rtx0))) (+ (* (getvar "TEXTSIZE") (sin rtx0)) (* (* (getvar "TEXTSIZE") 0.5) (cos rtx0))) 0.0 ) ) ">%).Coordinates \\f \"%lu2%pt1%pr3%ps[X=,]\">%" 7 (getvar "TEXTSIZE") 5 "Romand-Field" "Id-XY" rtx ) (list (mapcar '+ pt_field (list (- (* (getvar "TEXTSIZE") (cos rtx0)) (* (- (* (getvar "TEXTSIZE") 0.5)) (sin rtx0))) (+ (* (getvar "TEXTSIZE") (sin rtx0)) (* (- (* (getvar "TEXTSIZE") 0.5)) (cos rtx0))) 0.0 ) ) ">%).Coordinates \\f \"%lu2%pt2%pr3%ps[Y=,]\">%" 1 (getvar "TEXTSIZE") 5 "Romand-Field" "Id-XY" rtx ) ) ) (setq l_max nil) (foreach n (append (textbox (list (assoc 1 (entget (ssname js 0))))) (textbox (list (assoc 1 (entget (ssname js 1)))))) (setq l_max (cons (apply 'max n) l_max))) (setq l_max (apply 'max l_max)) (command "_.pline" "_none" pt_pos "_none" pt_field "_none" (setq p1 (polar pt_field (+ rtx (* 0.5 pi)) (* 2.0 (getvar "TEXTSIZE")))) "_none" (setq p2 (polar p1 rtx (+ l_max (* (getvar "TEXTSIZE") 3.0)))) "_none" (setq p3 (polar p2 (- rtx (* 0.5 pi)) (* 4.0 (getvar "TEXTSIZE")))) "_none" (polar p3 (+ rtx pi) (+ l_max (* (getvar "TEXTSIZE") 3.0))) "_close" ) ) (prin1) ) Si la police ne te convient pas, il te suffit d'en affecter une autre après coup au style Romman-field et de regénérer ton dessin. Si les points sont déplacés, les champs seront mis à jour.

Salut Recopie la feuille active après la feuille active (setq xls (vlax-get-or-create-object "excel.application")) (vlax-invoke (vlax-get xls 'activesheet) 'copy nil (vlax-get xls 'activesheet)) @+