Ecrire des textes en decalage de polyligne

[lecrabe]

Hello

 

J'ai cherche sur le Net sans trouver ce qui m'interesse !? :o

 

Donc voici mon probleme et donc mon CDC/CCTP

qui peut interesser des gens dans le domaine de la voirie :

 

Soit une jolie polyligne (voire meme N Plines) qui serai(en)t en fait un axe de FUTURE voirie,

je desire generer des textes numeriques avec une valeur de depart parametrable, un increment de valeur parametrable, une distance/pas parametrable, un decalage gauche/droite parametrable (largeur de la voie + largeur trottoir "en gros"), ces textes seraient en fait des simples numeros de voiries avec alternance gauche/droite et alternance de pair/impair

 

Exemple a l'horizontale :

 

11 13 15

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

12 14 16

 

Bien entendu si distance/pas = ZERO alors les Numeros de voirie pairs et impairs sont en face l'un de l'autre

Ou si distance/pas = 10 alors les Numeros de voirie pairs ou impairs sont a 20 m les uns des autres (sur le meme cote)

 

Donc voila comment je vois le truc :

 

- Selection des N Plines

- Valeur de depart (Defaut=1)

- Valeur de l'Increment (Defaut =1)

- Valeur du pas/distance en longueur (Defaut = 10) - Un No pair ou Impair tous les 10 m

- Valeur du decalage (Demi largeur de voie+trottoir) (Defaut=5)

Si = ZERO alors on traite seulement UN cote,

donc question : Gauche ou Droite (Defaut = gauche)

- Rotation du texte (Defaut = 0, sinon suivre la "pente / orientation" de la polyligne si possible)

 

Traitement des N Plines ...

 

Voila je pense n'avoir rien oublie et cela devrait rendre service

a un certain nombre de personnes !? :D

 

Merci d'avance si qq'un a le courage de se lancer !?

 

Le Decapode

 

 

[fabcad]

Hello à tous,

Bonjour Lecrabe,

 

Super ton CDC, avec cette base de lisp, et avec des champs de table de données d'objet (ou d'Xdatas) de numéros de voies de début et de fin ou alors le premier et le dernier d'une suite de numéros, (l'exemple type c'est les impasses où la numérotation est de type 1 2 3 4 5 6 7 etc.).

 

J'espère un retour sur ce sujet.

 

Fabcad

 

[bonuscad]

Salut,

 

Il y a eu certainement des demandes anciennes proches de la tienne.

 

A un moment j'avais posté ceci

 

Sur mon disque j'ai retrouvé une même version remaniée qui tends plus vers ta demande.

 

Je te la poste pour inspiration, mais réécrire des modifs ou n versions pour Pierre, Paul, Jacques...

 

Un jour il faut se lancer dans l'écriture pour être bien servi.

 

(defun make_blk_measure ( / all_path n id_path fonts file_shx)
    (if (not (tblsearch "STYLE" "$BLK_MEAS"))
   (progn
     (setq all_path (getenv "ACAD")
     n      0
     )
     (while (setq end_pos (vl-string-position (ascii ";") all_path))
 (setq id_path (substr all_path 1 end_pos))
 (if (wcmatch (strcase id_path) "*FONTS*")
   (setq fonts_path (strcat id_path "\\"))
 )
 (setq all_path (substr all_path (+ 2 end_pos)))
     )
     (setq file_shx (getfiled "Selectionnez un fichier de police"
            fonts_path
            "shx"
            8
        )
     )
     (if (not file_shx)
 (setq file_shx "txt.shx")
     )
     (entmake
 (append
               '((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)
     (4 . "")
    )
   (list (cons 3 file_shx))
 )
     )
   )
 )
    (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
    '((0 . "POINT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbPoint") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (50 . 0.0))
  )
  (entmake
   '(
 (0 . "ATTDEF")
 (100 . "AcDbEntity")
 (67 . 0)
 (410 . "Model")
 (8 . "0")
 (100 . "AcDbText")
 (10 0.05 0.1 0.0)
 (40 . 0.1)
 (1 . "0.0")
 (50 . 1.570796326794896)
 (41 . 1.0)
 (51 . 0.0)
 (7 . "$BLK_MEAS")
 (71 . 0)
 (72 . 0)
 (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 inc_txt (Txt / Boucle Decalage Val_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 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:blk-att_measure ( / js dxf_obj obj_vlax pt_start pt_end total_dist partial_dist lst_pt flag n_ini increment_dist sv_luprec sv_dzin d_post prfx sffx a ang dxf_210 nb nb_dec inc)
 (princ "\nSélectionner un objet curviligne à mesurer/diviser: ")
 (while
   (not
     (setq js
       (ssget "_+.:E:S"
         (list
           (cons 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"))
           (cons -4 "            (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))
 )
 (initget "Mesurer Diviser _Measure Divide")
 (if (eq (getkword (strcat "\n[Mesurer/Diviser] l'objet d'une longueur de " (rtos total_dist) "? : ")) "Divide")
   (progn
     (initget 7)
     (setq
       partial_dist (getint "\nEntrez le nombre de segments: ")
       partial_dist (/ total_dist partial_dist)
     )
   )
   (progn
     (initget 7)
     (setq partial_dist (getdist "\nSpécifiez la longueur du segment: "))
   )
 )
 (cond
   ((> total_dist partial_dist)
     (make_blk_measure)
     (setq
       lst_pt (list pt_start)
       increment_dist partial_dist
       sv_luprec (getvar "LUPREC")
       sv_dzin (getvar "DIMZIN")
     )
     (setvar "CMDECHO" 1)
     (setvar "DIMZIN" 3)
     (setq d_post (getvar "DIMPOST") prfx "" sffx "")
     (while (and (/= (setq a (substr d_post 1 1)) "") (/= a "<"))
       (setq prfx (strcat prfx a) d_post (substr d_post 2))
     )
     (if (/= d_post "") (setq sffx (substr d_post 3)))
     (command "_.luprec" pause)
     (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)))
     (initget "Mesurée Incrémentée _Measured Incremented")
     (if (eq (getkword "\nExécuter avec valeur [Mesurée/Incrémentée]  ?: ") "Incremented")
       (progn
         (setq flag T)
         (if (not n_next)
           (setq
             n_ini (getstring "\nEntrer une valeur (chiffre, lettre ou alphanumérique)pour débuter l'incrémentation: ")
             n_next n_ini
           )
           (progn
             (initget "Oui Non _Yes No")
             (if (eq (getkword "\nRéinitialiser l'incrémentation [Oui/Non] : ") "Yes")
               (setq
                 n_ini (getstring T "\nEntrer une valeur (chiffre, lettre ou alphanumérique)pour débuter l'incrémentation: ")
                 n_next n_ini
               )
               (setq n_ini n_next)
             )
           )
         )
         (if (or (eq (type (read n_ini)) 'INT) (eq (type (read n_ini)) 'REAL))
           (setq inc (getint "\nValeur d'incrémentation <1>?: "))
         )
         (if (not inc) (setq inc 1))
       )
       (setq flag nil)
     )
     (foreach n lst_pt
       (setq
         ang (angle (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax n)) '(0.0 0.0 0.0))
         dxf_210 (z_dir n (polar n ang (* 0.1 partial_dist)))
       )
       (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 (* 0.1 partial_dist))
           (cons 1 (if flag (strcat prfx n_next sffx) (strcat prfx (rtos (vlax-curve-getDistAtPoint obj_vlax n)) sffx)))
           (cons 50 (+ (/ pi 2) ang))
           (cons 41 1.0)
           (cons 51 0.0)
           (cons 7 "$BLK_MEAS")
           (cons 71 0)
           (cons 72 0)
           (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)))
     (setq
       diag_box (textbox (setq dxf_ent (entget (entnext (entlast)))))
       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))

(entmake
(list
 (cons 0 "LWPOLYLINE")
 (cons 100 "AcDbEntity")
 (assoc 67 dxf_obj)
 (assoc 410 dxf_obj)
 (cons 8 (getvar "CLAYER"))
 (cons 100 "AcDbPolyline")
 (cons 90 4)
 (cons 70 1)
 (cons 43 (/ (getvar "PLINEWID") (* 0.1 partial_dist )))
 (cons 38 (caddr (trans n 0 dxf_210)))
 (cons 39 (getvar "THICKNESS"))
 (cons 10 (car lst_box))
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (cadr lst_box))
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (caddr lst_box))
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 10 (cadddr lst_box))
 (cons 40 0.0)
 (cons 41 0.0)
 (cons 42 0.0)
 (cons 210 dxf_210)
)
)
       (if flag
         (progn
           (setq n_ini n_next)
           (cond
             ((eq (type (read n_ini)) 'INT)
               (setq n_next (itoa (+ inc (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))))
                 )
               )
               (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))
             )
           )
         )
       )
     )
     (setvar "LUPREC" sv_luprec)
     (setvar "DIMZIN" sv_dzin)
   )
   (T (princ "\nLa longueur est trop grande pour l'objet!"))
 )
 (prin1)
)