Aller au contenu

[Résolu] Lisp pour extraire coordonnées et insérer dans Autocad


Maxime85

Messages recommandés

Bonjour, j aimerais avoir un lisp qui me permet extraire les coordonnées en planimétrie de n importe quel point sur Autocad et d' insérer ces coordonnées dans Autocad comme sur la pièce jointe Cordialement

post-36320-0-54129300-1424349801_thumb.jpg

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

Pourquoi un LISP avec un bloc avec attributs avec coordonnés de points.

 

De plus tu dois pouvoir mettre l'origine ou tu le souhaite.

"98% des soucis informatiques sont assis entre la chaise et le bureau !"

 

"C'est parce que la vitesse de la lumière est supérieure à celle du son que tant de gens paraissent brillants avant d'avoir l'air con."
Lien vers le commentaire
Partager sur d’autres sites

Sinon, covadis le fait avec les étiquettes "coter des points ou des blocs"... _CovaLabelPts

 

(Rien à voir, juste une petite remarque au sujet de la "citation" en signature de maxime85... met une belette, une fouine ou une martre dans un poulailler et tu verras que l'homme n'est pas le seul à tuer par plaisir... ms bon, y'a du vrai malgré tout! ;) )

AutoCad Map 3D 2011 - Covadis v16.0d

Windows 7 - 64b

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

Merci beaucoup Lecrabe certes le rendu final n est pas trop terrible mais ça donne ce donc j ai besoin une fois de plus merci .

 

Oui Demixav Covadis le fais très bien je n en disconvient pas mais le hic est que nous n avons qu'une seul licence de Covadis ,

 

quand il y a beaucoup a faire (par exemple données les coordonnées planimétrique d' implantation d'un dalot ) imagine t as 100

 

du coup ceux qui n ont pas covadis ça peu leur aidé a travaillé smile.gif

 

Cordialement

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

Hello Maxime

 

J'adore les gens qui disent "MERCI" cela est rare parfois !?

 

Donc comme en plus tu critiques cette ANTIQUE routine XY & XYZ ,

je m'autorise dans un moment de folle generosite a t'octroyer une 2eme routine

"beaucoup plus jolie" car elle utilise les MLeaders (donc aussi les Styles de MLeader)

 

SVP tu regardes bien le commentaire relatif a DIMZIN ...

 

2 commandes : LBXY & LBXYZ

 

J'ose esperer que son altesse Maxime sera satisfaite !?

 

Bye, lecrabe

 

PS: SVP au fait pourquoi Maxime85, tu es Vendeen ?

LBXY__LBXYZ__MLeader__Label_XY_XYZ.zip

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

une fois de plus merci Lecrabe mais toujours pas satisfais certes amélioré car on peu avoir plus de précision le premier semblait être limité a 2 chiffres après la virgule au faite l idée est d' avoir ces coordonnées dans un rectangle avec bord arrondi (genre oblong) ou rectangulaire simplement

par ailleurs merci Djn06 mais pas la peine de rire moi ça ne fais pas rire en plus nous ne sommes pas tous né égale donc ...

 

 

d' autre part Devimax vérifie ta signature je pense que l exemple vaut mieux que la leçon

Cordiales salutations a tous

PS: Vendeen mean what ???

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

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.

  • Upvote 1

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

Ou encore cet autre, que j'avais fais pour quelqu'un qui voulait renseigner automatiquement les sommets d'une polyligne.

Les possibilités sont multiples, suffit de les écrire...

 

(defun inc_txt (Txt / Boucle Decalage Val_Txt Ascii_Txt)
 (setq Boucle 1 Val_txt "")
 (while (<= Boucle (strlen Txt))
   (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle)))
   (if (not Decalage)
     (setq Ascii_Txt (1+ Ascii_Txt))
   )
   (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123))
     (setq
       Ascii_Txt
       (cond
         ((= Ascii_Txt 58) 48)
         ((= Ascii_Txt 91) 65)
         ((= Ascii_Txt 123) 97)
       )
       Decalage nil
     )
     (setq Decalage T)
   )
   (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt))
   (setq Boucle (1+ Boucle))
 )
 (if (not Decalage)
   (setq Val_Txt
     (strcat
       (cond
         ((< Ascii_Txt 58) "0")
         ((< Ascii_Txt 91) "A")
         ((< Ascii_Txt 123) "a")
       )
       Val_Txt
     )
   )
 )
 Val_Txt
)
(defun c:BlockAtt2Vtx ( / js lst_posatt n nb_e ent dxf_ent dxf_210 lst_pt lst_dist lst_num vlaobj perim_obj pr n_ini n_next pt abs_curv nb nb_dec inc x y z d num ang pos_att)
 (cond
   ((eq (getvar "cvport") 1)
     (princ "\n** Commande autorisée uniquement dans l'espace objet.")
   )
   (T
     (if (not (tblsearch "STYLE" "Arial"))
       (entmake
         '(
         (0 . "STYLE")
         (5 . "40")
         (100 . "AcDbSymbolTableRecord")
         (100 . "AcDbTextStyleTableRecord")
         (2 . "Arial")
         (70 . 0)
         (40 . 0.0)
         (41 . 1.0)
         (50 . 0.0)
         (71 . 0)
         (42 . 2.5)
         (3 . "arial.ttf")
         (4 . "")
         )
       )
     )
     (if (not (tblsearch "BLOCK" "Pointer"))
       (progn
         (entmake
           '((0 . "BLOCK") (2 . "Pointer") (70 . 2) (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2) (10 0.0 0.0 0.0))
         )
         (entmake
           '(
           (0 . "LWPOLYLINE")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbPolyline")
           (90 . 7)
           (70 . 1)
           (43 . 0.5)
           (38 . 0.0)
           (39 . 0.0)
           (10 19.0 11.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 19.0 8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 75.0 8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 75.0 -8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 19.0 -8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 19.0 -11.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 0.0 0.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (210 0.0 0.0 1.0)
           )
         )
         (entmake
           '(
           (0 . "LWPOLYLINE")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbPolyline")
           (90 . 2)
           (70 . 0)
           (43 . 0.5)
           (38 . 0.0)
           (39 . 0.0)
           (10 41.0 8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 41.0 -8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (210 0.0 0.0 1.0)
           )
         )
         (entmake
           '(
           (0 . "LWPOLYLINE")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbPolyline")
           (90 . 2)
           (70 . 0)
           (43 . 0.5)
           (38 . 0.0)
           (39 . 0.0)
           (10 46.0 8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (10 46.0 -8.0)
           (40 . 0.5)
           (41 . 0.5)
           (42 . 0.0)
           (91 . 0)
           (210 0.0 0.0 1.0)
           )
         )
         (entmake
           '(
           (0 . "TEXT")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbText")
           (10 42.6909 5.0 0.0)
           (40 . 2.0)
           (1 . "L")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 0)
           (11 0.0 0.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbText")
           (73 . 0)
           )
         )
         (entmake
           '(
           (0 . "TEXT")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbText")
           (10 42.6909 2.0 0.0)
           (40 . 2.0)
           (1 . "X")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 0)
           (11 0.0 0.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbText")
           (73 . 0)
           )
         )
         (entmake
           '(
           (0 . "TEXT")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbText")
           (10 42.6909 -1.0 0.0)
           (40 . 2.0)
           (1 . "Y")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 0)
           (11 0.0 0.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbText")
           (73 . 0)
           )
         )
         (entmake
           '(
           (0 . "TEXT")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbText")
           (10 42.6909 -4.0 0.0)
           (40 . 2.0)
           (1 . "Z")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 0)
           (11 0.0 0.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbText")
           (73 . 0)
           )
         )
         (entmake
           '(
           (0 . "TEXT")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (62 . 1)
           (100 . "AcDbText")
           (10 42.6909 -7.0 0.0)
           (40 . 2.0)
           (1 . "D")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 0)
           (11 0.0 0.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbText")
           (73 . 0)
           )
         )
         (entmake
           '(
           (0 . "ATTDEF")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (100 . "AcDbText")
           (10 53.0334 -4.0 0.0)
           (40 . 8.0)
           (1 . "-")
           (50 . 0.0)
           (41 . 0.65)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 1)
           (11 60.5 0.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbAttributeDefinition")
           (280 . 0)
           (3 . "Tag No")
           (2 . "TAG")
           (70 . 0)
           (73 . 0)
           (74 . 2)
           (280 . 1)
           )
         )
         (entmake
           '(
           (0 . "ATTDEF")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (100 . "AcDbText")
           (10 27.6671 5.0 0.0)
           (40 . 2.0)
           (1 . "-")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 2)
           (11 39.0 5.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbAttributeDefinition")
           (280 . 0)
           (3 . "Length")
           (2 . "LENGTH")
           (70 . 0)
           (73 . 0)
           (74 . 0)
           (280 . 1)
           )
         )
         (entmake
           '(
           (0 . "ATTDEF")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (100 . "AcDbText")
           (10 28.91 2.0 0.0)
           (40 . 2.0)
           (1 . "-")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 2)
           (11 39.0 2.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbAttributeDefinition")
           (280 . 0)
           (3 . "X Cooordinate")
           (2 . "XCORD")
           (70 . 0)
           (73 . 0)
           (74 . 0)
           (280 . 1)
           )
         )
         (entmake
           '(
           (0 . "ATTDEF")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (100 . "AcDbText")
           (10 28.91 -1.0 0.0)
           (40 . 2.0)
           (1 . "-")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 2)
           (11 39.0 -1.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbAttributeDefinition")
           (280 . 0)
           (3 . "Y Cooordinate")
           (2 . "YCORD")
           (70 . 0)
           (73 . 0)
           (74 . 0)
           (280 . 1)
           )
         )
         (entmake
           '(
           (0 . "ATTDEF")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (100 . "AcDbText")
           (10 29.0668 -4.0 0.0)
           (40 . 2.0)
           (1 . "-")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 2)
           (11 39.0 -4.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbAttributeDefinition")
           (280 . 0)
           (3 . "ZCooordinate")
           (2 . "ZCORD")
           (70 . 0)
           (73 . 0)
           (74 . 0)
           (280 . 1)
           )
         )
         (entmake
           '(
           (0 . "ATTDEF")
           (100 . "AcDbEntity")
           (67 . 0)
           (410 . "Model")
           (8 . "0")
           (100 . "AcDbText")
           (10 31.2374 -7.0 0.0)
           (40 . 2.0)
           (1 . "-")
           (50 . 0.0)
           (41 . 1.0)
           (51 . 0.0)
           (7 . "Arial")
           (71 . 0)
           (72 . 2)
           (11 39.0 -7.0 0.0)
           (210 0.0 0.0 1.0)
           (100 . "AcDbAttributeDefinition")
           (280 . 0)
           (3 . "Description")
           (2 . "DESC")
           (70 . 0)
           (73 . 0)
           (74 . 0)
           (280 . 1)
           )
         )
         (entmake '((0 . "ENDBLK") (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2)))
       )
     )
     (princ "\nSélectionner les Polylignes où placer un bloc avec attributs")
     (setq js (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>"))))
     (cond
       (js
         (setq lst_posatt '((60.5 0.0 0.0) (39.0 5.0 0.0) (39.0 2.0 0.0) (39.0 -1.0 0.0) (39.0 -4.0 0.0) (39.0 -7.0 0.0)))
         (repeat (setq n (sslength js))
           (setq dxf_ent (entget (setq ent (ssname js (setq n (1- n))))) dxf_210 (cdr (assoc 210 dxf_ent)) lst_pt nil lst_dist nil lst_num nil)
           (setq
             vlaobj (vlax-ename->vla-object ent)
             perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj))
             pr -1
           )
           (if (not n_next)
             (setq
               n_ini (getstring "\nIncrementer en débutant à [chiffre/lettre/alphanumérique]: ")
               n_next (if (eq n_ini "") "0" n_ini)
             )
             (progn
               (initget "Oui Non _Yes No")
               (if (eq (getkword "\nRéinitialiser l'incrémentation [Oui/Non] <Non>: ") "Yes")
                 (setq
                   n_ini (getstring "\nIncrementer en débutant à [chiffre/lettre/alphanumérique]: ")
                   n_next (if (eq n_ini "") "0" n_ini)
                 )
                 (setq n_ini n_next)
               )
             )
           )
           (repeat (setq nb_e (if (zerop (vlax-get vlaobj 'Closed)) (1+ (fix (vlax-curve-getEndParam vlaobj))) (fix (vlax-curve-getEndParam vlaobj))))
             (setq
               pt (vlax-curve-GetPointAtParam vlaobj (setq pr (1+ pr)))
               lst_pt (cons pt lst_pt)
               abs_curv (vlax-curve-getDistAtPoint vlaobj (vlax-curve-getClosestPointTo vlaobj (trans pt 1 0)))
               lst_dist (cons abs_curv lst_dist)
               lst_num (cons n_next lst_num)
             )
             (setq n_ini n_next)
             (cond
               ((eq (type (read n_ini)) 'INT)
                 (setq n_next (itoa (1+ (atoi n_ini))))
               )
               ((eq (type (read n_ini)) 'REAL)
                 (setq nb 0)
                 (repeat (strlen n_ini)
                   (if (eq (substr n_ini (setq nb (1+ nb)) 1) ".")
                     (setq nb_dec (1- (strlen (substr n_ini nb))))
                   )
                 )
                 (setq inc 1.0)
                 (repeat nb_dec (setq inc (/ inc 10)))
                 (setq n_next (rtos (+ inc (atof n_ini)) 2 nb_dec))
               )
               ((eq (type n_ini) 'STR)
                 (setq n_next (inc_txt n_ini))
               )
             )
           )
           (foreach pto lst_pt
             (setq
               x (car pto)
               y (cadr pto)
               z (caddr pto)
               d (car lst_dist)
               num (car lst_num)
               ang (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (vlax-curve-getParamAtPoint vlaobj pto))))
               pos_att (mapcar '(lambda (x) (polar (trans '(0.0 0.0 0.0) dxf_210 0) (+ (angle (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)) ang) (distance (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)))) lst_posatt)
             )
             (entmake
               (append
                 '(
                 (0 . "INSERT")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbBlockReference")
                 (66 . 1)
                 (2 . "Pointer")
                 (41 . 1.0)
                 (42 . 1.0)
                 (43 . 1.0)
                 (70 . 0)
                 (71 . 0)
                 (44 . 0.0)
                 (45 . 0.0)
                 )
                 (list (cons 50 ang) (cons 10 (trans pto 0 dxf_210)) (cons 210 dxf_210))
               )
             )
             (entmake
               (append
                 '(
                 (0 . "ATTRIB")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbText")
                 )
                 (list
                   (cons 50 ang)
                   (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 1 num)
                 )
                 '(
                 (40 . 8.0)
                 (41 . 0.65)
                 (51 . 0.0)
                 (7 . "Arial")
                 (71 . 0)
                 (72 . 1)
                 )
                 (list
                   (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 210 dxf_210)
                 )
                 '(
                 (100 . "AcDbAttribute")
                 (2 . "TAG")
                 (70 . 0)
                 (73 . 0)
                 (74 . 2)
                 )
               )
             )
             (setq pos_att (cdr pos_att))
             (entmake
               (append
                 '(
                 (0 . "ATTRIB")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbText")
                 )
                 (list
                   (cons 50 ang)
                   (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 1 (rtos d 2 4))
                 )
                 '(
                 (40 . 1.0)
                 (41 . 1.0)
                 (51 . 0.0)
                 (7 . "Arial")
                 (71 . 0)
                 (72 . 2)
                 )
                 (list
                   (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 210 dxf_210)
                 )
                 '(
                 (100 . "AcDbAttribute")
                 (2 . "LENGTH")
                 (70 . 0)
                 (73 . 0)
                 (74 . 0)
                 )
               )
             )
             (setq pos_att (cdr pos_att))
             (entmake
               (append
                 '(
                 (0 . "ATTRIB")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbText")
                 )
                 (list
                   (cons 50 ang)
                   (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 1 (rtos x 2 4))
                 )
                 '(
                 (40 . 1.0)
                 (41 . 1.0)
                 (51 . 0.0)
                 (7 . "Arial")
                 (71 . 0)
                 (72 . 2)
                 )
                 (list
                   (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 210 dxf_210)
                 )
                 '(
                 (100 . "AcDbAttribute")
                 (2 . "XCORD")
                 (70 . 0)
                 (73 . 0)
                 (74 . 0)
                 )
               )
             )
             (setq pos_att (cdr pos_att))
             (entmake
               (append
                 '(
                 (0 . "ATTRIB")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbText")
                 )
                 (list
                   (cons 50 ang)
                   (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 1 (rtos y 2 4))
                 )
                 '(
                 (40 . 1.0)
                 (41 . 1.0)
                 (51 . 0.0)
                 (7 . "Arial")
                 (71 . 0)
                 (72 . 2)
                 (11 0.0 0.0 0.0)
                 )
                 (list
                   (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 210 dxf_210)
                 )
                 '(
                 (100 . "AcDbAttribute")
                 (2 . "YCORD")
                 (70 . 0)
                 (73 . 0)
                 (74 . 0)
                 )
               )
             )
             (setq pos_att (cdr pos_att))
             (entmake
               (append
                 '(
                 (0 . "ATTRIB")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbText")
                 )
                 (list
                   (cons 50 ang)
                   (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 1 (rtos z 2 4))
                 )
                 '(
                 (40 . 1.0)
                 (41 . 1.0)
                 (51 . 0.0)
                 (7 . "Arial")
                 (71 . 0)
                 (72 . 2)
                 )
                 (list
                   (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 210 dxf_210)
                 )
                 '(
                 (100 . "AcDbAttribute")
                 (2 . "ZCORD")
                 (70 . 0)
                 (73 . 0)
                 (74 . 0)
                 )
               )
             )
             (setq pos_att (cdr pos_att))
             (entmake
               (append
                 '(
                 (0 . "ATTRIB")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (100 . "AcDbText")
                 )
                 (list (cons 50 ang) (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)))
                 '(
                 (1 . "EXISTING")
                 (40 . 1.0)
                 (41 . 1.0)
                 (51 . 0.0)
                 (7 . "Arial")
                 (71 . 0)
                 (72 . 2)
                 )
                 (list
                   (cons 11 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210))
                   (cons 210 dxf_210)
                 )
                 '(
                 (100 . "AcDbAttribute")
                 (2 . "DESC")
                 (70 . 0)
                 (73 . 0)
                 (74 . 0)
                 )
               )
             )
             (entmake '((0 . "SEQEND") (62 . 256) (6 . "ByLayer") (370 . -2)))
             (setq lst_dist (cdr lst_dist) lst_num (cdr lst_num))
           )
           (princ (strcat "\n" (itoa nb_e) " blocs \"Pointer\" placés et renseignés."))
         )
       )
       (T (princ "\nSélection non valide ou vide."))
     )
   )
 )
 (prin1)
)

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 ,

 

Bravo Bonuscad +1 le premier répond parfaitement a mes besoins t es un pro biggrin.gif merci pour ce lisp mes collègues

 

gagnerons beaucoup en temps

Devimax je sais que c est la plaisanterie au faite je disais t as pas préciser dans ta signature que t avais une seul licence de Covadis ou

Mapdry.gif

 

Cordiales salutations

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

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é