Copie incrémentale

metacilla · le 9 septembre 2013

Bonjour à tous,

j'ai besoin d'un petit coup de main, j'ai 25 Km de cana a poser et il faut que tous les 50m il y ai un texte comme celui ci (0+000m)Voyez vous mon souci 500 texte ou bloc à renommer.... j'ai bien trouver le lisp GILE_INCREMENT mais le souci c'est que contrairement à la commande MESURER d'autocad il ne me pivote pas les texte par rapport à la polyligne....

Y a t-il une solution à mon problème?

un texte (ou bloc) incrémenté de 50 tous les 50m (0+000, 0+050, 0+100, ...) perpendiculaire à la polyligne.

Merci d'avance à tous

metacilla · le 9 septembre 2013

Désolè du spam....

mais j'avais un message d'erreur en validant...

x_all · le 9 septembre 2013

c'est sur que là elle est bien incrémenté la copie... ( :) )

si tu fait un mesurer avec un bloc qui à un attribut, on doit pouvoir faire un lisp qui incrémente la valeur de l'attribut avec un pas donné pour une sélection de bloc...

bonuscad · le 9 septembre 2013

Bonjour,

J'avais fait ceci: mesure_PK.lsp

Je l'avais publié sur CadXp, faire une recherche avec le mot mesure_PK sur le site pour avoir l'historique et les ajustements éventuels demandés.

Julian-Nihon · le 9 septembre 2013

Incremental Numbering Suite (Numinc) de Lee-Mac

Je crois que ca fait tout ce que tu veux ^^"

Ju du Japon

metacilla · le 9 septembre 2013

Merci à tous... j'essaye desespérement de modifier vos lisp car ils ont tous qqch qui ne vont pas avec mon projet...

Julian-Nihon: il fait tout très bien mais il ne suis pas la polyligne... :-(

Bonuscad: J'ai réussi a modifier le fait qu'il insère le texte tous les 1000m je l'ai bien mis à 50m mais il incrémente de 1000m 0+000, 1+000, 2+000 :-(

et là mes maigre connaissance en informatique sont dépassé...

Le texte n'est pas non plus centré sur la polyligne et est tourner de 180° de trop! :-( sinon tip top!!! :-D

Donc je cherche toujours... et j'essayerais d'y passer ma nuit pour modifier...

Merci encore.

x_all · le 9 septembre 2013

je vien de redemander ici un lien vers Latt

ce lisp incrémente les blocs avec attribut.

donc tu te fait un bloc qui va bien, puis mesurer avec un alignement qui suis la poly, tu selec tes blocs et les incrémente avec latt.

ça devrait marcher assez vite...

--------------------------------

edit

après esais c'est pas adapté...

je vais chercher a pondre un truc ce soir...

bonuscad · le 9 septembre 2013

Bonuscad: J'ai réussi a modifier le fait qu'il insère le texte tous les 1000m je l'ai bien mis à 50m mais il incrémente de 1000m 0+000, 1+000, 2+000 :-(
et là mes maigre connaissance en informatique sont dépassé...
Le texte n'est pas non plus centré sur la polyligne et est tourner de 180° de trop!

C'est vrai que je l'ai conçu pour de la cotation kilométrique...

Néanmoins on peut essayer de modifier certain trucs!

dans la partie ATTDEF changer:

(50 . 1.570796326794896);rotation pi/2
..
(72 . 0);justification gauche

en

(50 . 0)
(72 . 1)

pour une rotation de 0 et justification centre

Dans la partie (defun c:mesure_PK

changer:

partial_dist 1000.0

en

partial_dist 50.0

et

increment_dist (- 1000.0 (atoi (substr (rtos ori_dist 2 3) (+ 2 (vl-string-search "." (rtos ori_dist 2 3))))))

en

increment_dist (- 50.0 (atoi (substr (rtos ori_dist 2 3) (+ 2 (vl-string-search "." (rtos ori_dist 2 3))))))

et dans la partie ATTRIB (en homogénéité avec ATTDEF)

changer:

(cons 50 (+ (/ pi 2) ang))

en

(cons 50 ang)

et

(cons 72 0)

en

(cons 72 1)

Cependant les préfixes résultants en +050 vont s'écrire +50, un "rechercher-remplacer" judicieux devrait pouvoir palier à ce petit inconvénient.

x_all · le 9 septembre 2013

plop...

bon, j'ai fait un truc qui marchouille, mais je maitrise pas tout :)

donc pour cette solution, je mesure ma poly avec un bloc qui à un seul attribut puis je passe la moulinette et les attributs prennent les valeurs incrémentées avec un pas et une valeur de départ à définir.

le hic, c'est que ça prend les valeurs dans l'ordre inverse que celui de la polyligne...

j'ai bien essayer d'inverser la liste mais ya encore un truc que je capte pas (je suis un grand débutant)

si qq1 arrive à corriger les lignes en commentaire j'apprendrai un truc de plus

en pj un exemple avec un bloc qui fonctionne

(defun c:iatu ()
 (vl-load-com)
 (setq	sel nil
bl  nil
 )
 (while (not sel)
   (setq sel (ssget (list '(0 . "INSERT")

	     )
      )
   )
 )
 (setq nb (sslength sel))

;;;(defun inverse (l)
;;;  (if (null l) nil
;;;    (append (inverse (cdr l)) (list (car l)))
;;;	    )
;;;)
;;;
;;;(setq sel (inverse sel))
 
 (or (setq dep (getreal "\nvaleur de départ départ <0>: "))
     (setq dep 0.0)
 )

 (or (setq inc (getreal "\nincrément <50>: "))
     (setq inc 50.0)
 )
 (setq	val (+ dep inc)             ;;mesurer ne pose pas le bloc 0.00
n   0
 )

 (while (setq bl (ssname sel n))
   (setq att (entget (entnext bl)))
   (setq fmtval (rtos val 2 2))
   (while (/= (cdr (assoc 0 att)) "SEQEND")
     (if (= (cdr (assoc 2 att)) "MEU")
(progn
  (setq att (subst (cons 1 fmtval) (assoc 1 att) att))
  (entmod att)
  (setq att (list (cons 0 "SEQEND")))
)
(setq att (entget (entnext (cdr (assoc -1 att)))))
     )
   )
   (setq val (+ val inc))
   (setq n (1+ n))
 )
)

metacilla · le 10 septembre 2013

Objet complexe non valable.; erreur: nombre d'arguments trop important

après tes modif BONUSCAD voilà le message que j'ai en réponse! :-(

metacilla · le 10 septembre 2013

PK de départ 0+000 <0.0>: Entrez une nouvelle valeur pour TEXTSIZE <5>: _.luprec

Entrez une nouvelle valeur pour LUPREC <0>: 0

Commande: ; erreur: nombre d'arguments trop important

x_all · le 10 septembre 2013

si mon bricolage à encore besoin de passer par R_pline de (gile) il marche...

même si le code est pas propre car pas fini ça te dépannerai peut etre...

metacilla · le 10 septembre 2013

Perso X-all j'utilise ta routine, mais il ne se passe rien... pas d'erreur mais il ne se passe rien les attribut ne change pas

x_all · le 10 septembre 2013

ATTSYNC ?

metacilla · le 10 septembre 2013

Rien bon je vais le faire à la main... j'ai déjà trop perdu de temps.... :-(

x_all · le 10 septembre 2013

tu utilises mon bloc?

tu vois l'attribut? le calque 0 est d'affiché?

si ça marche pour mon dessin, je comprend pas pourquoi ça marche pas chez toi...

bonuscad · le 10 septembre 2013

Salut,

Je pense que tu as mal fait les modifications, mais j'avais aussi mal corrigé une ligne proposée.

Voici le code complet, en espérant que celui-ci te convienne...

(defun make_blk_measure ( / )
   (if (not (tblsearch "STYLE" "$BLK_MEAS"))
     (entmake '((0 . "STYLE")
     (5 . "40")
     (100 . "AcDbSymbolTableRecord")
     (100 . "AcDbTextStyleTableRecord")
     (2 . "$BLK_MEAS")
     (70 . 0)
     (40 . 0.0)
     (41 . 1.0)
     (50 . 0.0)
     (71 . 0)
     (42 . 0.1)
     (3 . "ARIAL.TTF")
     (4 . "")
    )
     )
   )
   (if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE"))
     (progn
  (entmake
   '((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
 )
 (entmake
   (append
     '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine"))
     (list (list 10 0.0 (/ (- (getvar "TEXTSIZE")) 100.0) 0.0))
     (list (list 11 0.0 (/ (getvar "TEXTSIZE") 100.0) 0.0))
     '((210 0.0 0.0 1.0))
   )
  )
  (entmake
   '(
 (0 . "ATTDEF")
 (100 . "AcDbEntity")
 (67 . 0)
 (410 . "Model")
 (8 . "0")
 (62 . 0)
 (6 . "ByBlock")
 (370 . -2)
 (100 . "AcDbText")
 (10 0.05 0.1 0.0)
 (40 . 1.0)
 (1 . "0.0")
 (50 . 0.0)
 (41 . 1.0)
 (51 . 0.0)
 (7 . "$BLK_MEAS")
 (71 . 0)
 (72 . 1)
 (11 0.0 0.1 0.0)
 (210 0.0 0.0 1.0)
 (100 . "AcDbAttributeDefinition")
 (3 . "measure")
 (2 . "VALUE_MEASURE")
 (70 . 0)
 (73 . 2)
 (74 . 2)
   )
 )
 (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
     )
   )
)
(defun z_dir (p1 p2 / )
 (trans
   '(0.0 1.0 0.0)
   (mapcar
     '(lambda (k)
       (/ k
         (sqrt
           (apply '+
             (mapcar
               '(lambda (x) (* x x))
               (mapcar '- p2 p1)
             )
           )
         )
       )
     )
     (mapcar '- p2 p1)
   )
   0
 )
)
(defun c:mesure_PK ( / js dxf_obj obj_vlax pt_start pt_end total_dist partial_dist ori_dist tmp_var lst_pt increment_dist sv_luprec sv_dzin ang dxf_210 p_fix mantiss)
 (princ "\nSélectionner un objet curviligne à mesurer: ")
 (while
   (not
     (setq js
       (ssget "_+.:E:S"
         (list
           (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE")
           (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
           (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
           (cons -4 "<NOT")
           (cons -4 "&") (cons 70 112)
           (cons -4 "NOT>")
         )
       )
     )
   )
   (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!")
 )
 (vl-load-com)
 (setq
   dxf_obj (entget (ssname js 0))
   obj_vlax (vlax-ename->vla-object (ssname js 0))
   pt_start (vlax-curve-getStartPoint obj_vlax)
   pt_end (vlax-curve-getEndPoint obj_vlax)
   total_dist (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax))
   partial_dist 50.0
 )
 (setq ori_dist (getreal "\nPK de départ 0+000 <0.0>: "))
 (if (not ori_dist) (setq ori_dist 0.0))
 (cond
   ((> total_dist partial_dist)
     (initget 6)
     (setq tmp_var (getdist (strcat "Entrez une nouvelle valeur pour TEXTSIZE <" (rtos (getvar "TEXTSIZE")) ">: ")))
     (if (not tmp_var) (setq tmp_var (getvar "TEXTSIZE")))
     (setvar "TEXTSIZE" tmp_var)
     (make_blk_measure)
     (setq
       sv_luprec (getvar "LUPREC")
       sv_dzin (getvar "DIMZIN")
     )
     (setvar "DIMZIN" 0)
     (setq
       lst_pt (list pt_start)
       increment_dist (rem (- 1000.0 (atoi (substr (rtos ori_dist 2 3) (+ 2 (vl-string-search "." (rtos ori_dist 2 3)))))) 50)
     )
     (setvar "CMDECHO" 1)
     (command "_.luprec" 0)
     (while (< increment_dist total_dist)
       (setq
         lst_pt (cons (vlax-curve-getPointAtDist obj_vlax increment_dist) lst_pt)
         increment_dist (+ increment_dist partial_dist)
       )
     )
     (setq lst_pt (reverse (cons pt_end lst_pt)))
     (foreach n lst_pt
       (setq
         ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax n)))
         dxf_210 (z_dir n (polar n ang (* 0.1 partial_dist)))
         p_fix (atoi (rtos (/ (vlax-curve-getDistAtPoint obj_vlax n) 1000.0) 2 3))
         mantiss
         (+
           (-
             (vlax-curve-getDistAtPoint obj_vlax n)
             (* p_fix 1000.0)
           )
           (atoi (substr (rtos ori_dist 2 3) (+ 2 (vl-string-search "." (rtos ori_dist 2 3)))))
         )
       )
       (if (or (equal mantiss 1000.0 1E-3) (> mantiss 1000.0)) (setq p_fix (1+ p_fix) mantiss (- mantiss 1000)))
       (if (zerop (fix mantiss))
         (setq mantiss "000")
         (if (eq (strlen (itoa (fix mantiss))) 2)
           (setq mantiss (strcat "0" (rtos mantiss 2 0)))
           (setq mantiss (rtos mantiss 2 0))
         )
       )
       (entmake
         (list
           (cons 0 "INSERT")
           (cons 100 "AcDbEntity")
           (assoc 67 dxf_obj)
           (assoc 410 dxf_obj)
           (cons 8 (getvar "CLAYER"))
           (cons 100 "AcDbBlockReference")
           (cons 66 1)
           (cons 2 "BLK_MEASURE_CURVE")
           (cons 10 (trans n 0 dxf_210))
           (cons 41 (* 0.1 partial_dist))
           (cons 42 (* 0.1 partial_dist))
           (cons 43 (* 0.1 partial_dist))
           (cons 50 ang)
           (cons 210 dxf_210)
         )
       )
       (entmake
         (list
           (cons 0 "ATTRIB")
           (cons 100 "AcDbEntity")
           (assoc 67 dxf_obj)
           (assoc 410 dxf_obj)
           (cons 8 (getvar "CLAYER"))
           (cons 100 "AcDbText")
           (cons 10
             (polar
               (polar (trans n 0 dxf_210) (+ (/ pi 2) ang) (* 0.1 partial_dist))
               ang
               (* 0.05 partial_dist)
             )
           )
           (cons 40 (getvar "TEXTSIZE"))
           (cons 1
             (strcat
               "PK "
               (itoa (+ p_fix (fix ori_dist)))
               "+"
               mantiss
             )
           )
           (cons 50 ang)
           (cons 41 1.0)
           (cons 51 0.0)
           (cons 7 "$BLK_MEAS")
           (cons 71 0)
           (cons 72 1)
           (cons 11 (polar (trans n 0 dxf_210) (+ (/ pi 2) ang) (* 0.1 partial_dist)))
           (cons 210 dxf_210)
           (cons 100 "AcDbAttribute")
           (cons 2 "VALUE_MEASURE")
           (cons 70 0)
           (cons 73 2)
           (cons 74 2)
         )
       )
       (entmake (list (cons 0 "SEQEND") (cons 8 (getvar "CLAYER")) (cons 62 0) (cons 6 "ByBlock") (cons 370 -2)))
     )
     (setvar "LUPREC" sv_luprec)
     (setvar "DIMZIN" sv_dzin)
   )
   (T (princ "\nLa longueur est trop grande pour l'objet!"))
 )
 (prin1)
)

NB: Si le block BLK_MEASURE_CURVE est déjà présent dans le dessin, penser à purger celui-ci avant de réessayer le code.

pierrevigneux · le 11 septembre 2013

J'ai une routine que j'utilise très souvent, grace à notre ami Gile, qui s'appelle Chaînage cette routine inscrit le long de la polyligne ton chaînage cumnulatif ex:0+000 etc... et inscrit un petit trait à ch. distance demandé par l'utilisateur.

(defun c:chainage (/       *error* dist    acdoc   space   incGrad incTxt
                  mult    cnt     label   height  ss      ins     text
                  ang     dz
                 )
 (vl-load-com)

 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark acdoc)
   (princ)
 )

 (setq dist  0
       acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       space (if (= 1 (getvar 'cvport))
               (vla-get-PaperSpace acdoc)
               (vla-get-ModelSpace acdoc)
             )
 )
 (while
   (not
     (or
       (and
         (setq label (getstring "\nEntrez la cote de départ <0+000>: "))
         (wcmatch label "*+*")
         (distof (vl-string-subst "." "+" label))
       )
       (and (= label "") (setq label "0+000"))
     )
   )
    (princ "\nLe format n'est pas valide.")
 )
 (initget 7)
 (setq incTxt (getint "\nIntervalle des annotations: "))
 (while
   (not
     (or
       (not (setq incGrad (getint (strcat "\nIntervalle des graduations <"
                                          (itoa incTxt)
                                          ">: "
                                  )
                          )
            )
       )
       (and incGrad (zerop (rem incTxt incGrad)))
     )
   )
    (princ (strcat "\nLa valeur doit être un diviseur de " (itoa incTxt)))
 )
 (or incGrad (setq incGrad incTxt))
 (setq mult (/ incTxt incGrad)
       cnt  mult
 )
 (initget 6)
 (setq height
        (cond
          ((getdist
             (strcat "\nHauteur de texte: <" (rtos (getvar 'textsize)) ">: ")
           )
          )
          ((getvar 'textsize))
        )
 )
 (if (ssget "_:S"
            '((0 . "*POLYLINE")
              (-4 . "<NOT")
              (-4 . "&")
              (70 . 120)
              (-4 . "NOT>")
             )
     )
   (progn
     (vla-StartUndoMark acdoc)
     (vlax-for curve (setq ss (vla-get-ActiveSelectionSet acdoc))
       (while (setq ins (vlax-curve-getPointAtDist curve dist))
         (setq ang  (angle '(0. 0. 0.)
                               (vlax-curve-getfirstDeriv
                                 curve
                                 (vlax-curve-getParamAtPoint curve ins)
                               )
                        )
               )
         (vla-AddLine
           space
           (vlax-3d-point (polar ins (+ ang (/ pi 2)) (/ height 2.)))
           (vlax-3d-point (polar ins (- ang (/ pi 2)) (/ height 2.)))
         )
         (if (= cnt mult)
           (progn
             (setq text
                        (vla-addText
                          space
                          label
                          (vlax-3d-point '(0. 0. 0.))
                          height
                        )
                   dz (getvar 'dimzin)
             )
             (vla-put-Alignment text acAlignmentBottomCenter)
             (if (minusp (cos ang))
               (setq ang (+ ang pi))
             )
             (vla-put-Rotation text ang)
             (vla-put-TextAlignmentPoint
               text
               (vlax-3d-point (polar ins (+ ang (/ pi 2)) height))
             )
             (setvar 'dimzin 1)
             (setq label
                    (vl-string-subst "+"
                                     "."
                                     (rtos
                                       (+ (/ incTxt 1000.)
                                          (atof (vl-string-subst "." "+" label))
                                       )
                                       2
                                       3
                                     )
                    )
                   cnt 0
             )
             (setvar 'dimzin dz)
           )
         )
         (setq dist (+ dist incGrad)
               cnt  (1+ cnt)
         )
       )
     )
     (vla-delete ss)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
)

(gile) · le 11 septembre 2013

Il me semblait bien que j'avais quelque chose dans ce sens, mais je ne le retrouvais plus.

Le code ci-dessus modifié pour répondre à la demande spécifique (orientation du texte).

(defun c:chainage (/       *error* dist    acdoc   space   incGrad incTxt
                  mult    cnt     label   height  ss      ins     text
                  ang     dz
                 )
 (vl-load-com)

 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark acdoc)
   (princ)
 )

 (setq dist  0
       acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       space (if (= 1 (getvar 'cvport))
               (vla-get-PaperSpace acdoc)
               (vla-get-ModelSpace acdoc)
             )
 )
 (while
   (not
     (or
       (and
         (setq label (getstring "\nEntrez la cote de départ <0+000>: "))
         (wcmatch label "*+*")
         (distof (vl-string-subst "." "+" label))
       )
       (and (= label "") (setq label "0+000"))
     )
   )
    (princ "\nLe format n'est pas valide.")
 )
 (initget 7)
 (setq incTxt (getint "\nIntervalle des annotations: "))
 (while
   (not
     (or
       (not (setq incGrad (getint (strcat "\nIntervalle des graduations <"
                                          (itoa incTxt)
                                          ">: "
                                  )
                          )
            )
       )
       (and incGrad (zerop (rem incTxt incGrad)))
     )
   )
    (princ (strcat "\nLa valeur doit être un diviseur de " (itoa incTxt)))
 )
 (or incGrad (setq incGrad incTxt))
 (setq mult (/ incTxt incGrad)
       cnt  mult
 )
 (initget 6)
 (setq height
        (cond
          ((getdist
             (strcat "\nHauteur de texte: <" (rtos (getvar 'textsize)) ">: ")
           )
          )
          ((getvar 'textsize))
        )
 )
 (if (ssget "_:S"
            '((0 . "*POLYLINE")
              (-4 . "<NOT")
              (-4 . "&")
              (70 . 120)
              (-4 . "NOT>")
             )
     )
   (progn
     (vla-StartUndoMark acdoc)
     (vlax-for curve (setq ss (vla-get-ActiveSelectionSet acdoc))
       (while (setq ins (vlax-curve-getPointAtDist curve dist))
         (setq	ang (angle '(0. 0. 0.)
		   (vlax-curve-getfirstDeriv
		     curve
		     (vlax-curve-getParamAtPoint curve ins)
		   )
	    )
  )
         (vla-AddLine
           space
           (vlax-3d-point (polar ins (+ ang (/ pi 2)) (/ height 2.)))
           (vlax-3d-point (polar ins (- ang (/ pi 2)) (/ height 2.)))
         )
         (if (= cnt mult)
           (progn
             (setq text
                        (vla-addText
                          space
                          label
                          (vlax-3d-point '(0. 0. 0.))
                          height
                        )
                   dz (getvar 'dimzin)
             )
             (vla-put-Alignment text acAlignmentMiddleLeft)
             (vla-put-Rotation text (+ ang (/ pi 2.)))
             (vla-put-TextAlignmentPoint
               text
               (vlax-3d-point (polar ins (+ ang (/ pi 2)) height))
             )
             (setvar 'dimzin 1)
             (setq label
                    (vl-string-subst "+"
                                     "."
                                     (rtos
                                       (+ (/ incTxt 1000.)
                                          (atof (vl-string-subst "." "+" label))
                                       )
                                       2
                                       3
                                     )
                    )
                   cnt 0
             )
             (setvar 'dimzin dz)
           )
         )
         (setq dist (+ dist incGrad)
               cnt  (1+ cnt)
         )
       )
     )
     (vla-delete ss)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
)

metacilla · le 16 septembre 2013

Un très grand merci à tous!!!

Vous êtes fabuleux, vu que j'ai de nouveau des modifs à faire sur mes trajectoires de cana mon chainage est à refaire.

(GILE ca fonctionne parfaitement sauf que ... oui il y a toujours un sauf....

il faudrait tourner les texte de 180°! :-(

j'ai réussi à les centré en modifiant:

-(vla-put-Alignment text acAlignmentMiddleLeft)

par

-vla-put-Alignment text acAlignmentMiddle)

Mais la rotation j'ai tourner en rond pas mal et rien.

Encore un grand merci pour le coup de main.

(gile) · le 16 septembre 2013

salut,

Remplace :

(vla-put-Rotation text (+ ang (/ pi 2.)))

par :

(vla-put-Rotation text (- ang (/ pi 2.)))

dilack · le 17 septembre 2013

Bonjour tout le monde,

J'essai de déplacer le point d'encrage du texte à 5m de l'axe, sans aucun résultat probant des modifs que je fais sur le code de gille.

Afin éviter de genre de résultat suivant la modif que Gille de faire.

http://img11.hostingpics.net/thumbs/mini_879665Capture.png

Le top est de pouvoir choisir la distance de décalage du texte.

Merci d'avance pour vos réponses.

(gile) · le 17 septembre 2013

C'est la dernière fois ! :P

(defun c:chainage (/       *error* dist    acdoc   space   incGrad incTxt
                  mult    cnt     label   height  offset ss      ins     text
                  ang     dz
                 )
 (vl-load-com)

 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark acdoc)
   (princ)
 )

 (setq dist  0
       acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       space (if (= 1 (getvar 'cvport))
               (vla-get-PaperSpace acdoc)
               (vla-get-ModelSpace acdoc)
             )
 )
 (while
   (not
     (or
       (and
         (setq label (getstring "\nEntrez la cote de départ <0+000>: "))
         (wcmatch label "*+*")
         (distof (vl-string-subst "." "+" label))
       )
       (and (= label "") (setq label "0+000"))
     )
   )
    (princ "\nLe format n'est pas valide.")
 )
 (initget 7)
 (setq incTxt (getint "\nIntervalle des annotations: "))
 (while
   (not
     (or
       (not (setq incGrad (getint (strcat "\nIntervalle des graduations <"
                                          (itoa incTxt)
                                          ">: "
                                  )
                          )
            )
       )
       (and incGrad (zerop (rem incTxt incGrad)))
     )
   )
    (princ (strcat "\nLa valeur doit être un diviseur de " (itoa incTxt)))
 )
 (or incGrad (setq incGrad incTxt))
 (setq mult (/ incTxt incGrad)
       cnt  mult
 )
 (initget 6)
 (setq height
        (cond
          ((getdist
             (strcat "\nHauteur de texte: <" (rtos (getvar 'textsize)) ">: ")
           )
          )
          ((getvar 'textsize))
        )
 )
 (initget 5)
 (setq offset (getdist "\nDécalage du texte: "))
 (if (ssget "_:S"
            '((0 . "*POLYLINE")
              (-4 . "<NOT")
              (-4 . "&")
              (70 . 120)
              (-4 . "NOT>")
             )
     )
   (progn
     (vla-StartUndoMark acdoc)
     (vlax-for curve (setq ss (vla-get-ActiveSelectionSet acdoc))
       (while (setq ins (vlax-curve-getPointAtDist curve dist))
         (setq ang (angle '(0. 0. 0.)
                          (vlax-curve-getfirstDeriv
                            curve
                            (vlax-curve-getParamAtPoint curve ins)
                          )
                   )
         )
         (vla-AddLine
           space
           (vlax-3d-point (polar ins (+ ang (/ pi 2)) (/ height 2.)))
           (vlax-3d-point (polar ins (- ang (/ pi 2)) (/ height 2.)))
         )
         (if (= cnt mult)
           (progn
             (setq text
                        (vla-addText
                          space
                          label
                          (vlax-3d-point '(0. 0. 0.))
                          height
                        )
                   dz (getvar 'dimzin)
             )
             (vla-put-Alignment text acAlignmentMiddleLeft)
             (vla-put-Rotation text (- ang (/ pi 2.)))
             (vla-put-TextAlignmentPoint
               text
               (vlax-3d-point (polar ins (- ang (/ pi 2)) offset))
             )
             (setvar 'dimzin 1)
             (setq label
                    (vl-string-subst "+"
                                     "."
                                     (rtos
                                       (+ (/ incTxt 1000.)
                                          (atof (vl-string-subst "." "+" label))
                                       )
                                       2
                                       3
                                     )
                    )
                   cnt 0
             )
             (setvar 'dimzin dz)
           )
         )
         (setq dist (+ dist incGrad)
               cnt  (1+ cnt)
         )
       )
     )
     (vla-delete ss)
     (vla-EndUndoMark acdoc)
   )
 )
 (princ)
)

dilack · le 19 septembre 2013

Salut à tous,

merci gille pour les modifs

metacilla · le 24 septembre 2013

Vous êtes aux TOP Merci à tous et longue vie à CAD XP

Connexion

Copie incrémentale

Messages recommandés

metacilla

metacilla

x_all

bonuscad

Julian-Nihon

metacilla

x_all

bonuscad

x_all

metacilla

metacilla

x_all

metacilla

x_all

metacilla

x_all

bonuscad

pierrevigneux

(gile)

metacilla

(gile)

dilack

(gile)

dilack

metacilla

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante