Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Polyligne avec largeur personnalisable et texte centré

Red

Par Red
dans LISP et Visual LISP

 Partager

Messages recommandés

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Pour reprendre le concept de DenisHen (qui évite le (cond ...)

La séquence pourrait être écrite comme suit:

 

 (if (not (eq (substr (getvar "USERS1") 1 3) "plw"))
   (setvar "USERS1" "plw0")
 )
 (initget "0 100 200 250 500 750")
 (setq key (getkword (strcat "\nDiamètre souhaité [0/100/200/250/500/750] <" (itoa (fix (* 100 (atof (substr (getvar "USERS1") 4 3))))) ">?: ")))
 (if key (setvar "USERS1" (strcat "plw" (rtos (/ (atoi Key) 100.0) 2 1))))
 (vlax-put nw_pl 'ConstantWidth (atof (substr (getvar "USERS1") 4)))

 

ou si tu préfère (getint) pour entroduire un diamètre sous forme d'entier.

 (if (not (eq (substr (getvar "USERS1") 1 3) "plw"))
   (setvar "USERS1" "plw0")
 )
 (initget 4)
 (setq key (getint (strcat "\nDiamètre souhaité <" (itoa (fix (* 100 (atof (substr (getvar "USERS1") 4 3))))) ">?: ")))
 (if key (setvar "USERS1" (strcat "plw" (rtos (/ Key 100.0) 2 1))))
 (vlax-put nw_pl 'ConstantWidth (atof (substr (getvar "USERS1") 4)))

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
Red Newbie

Red

Posté(e)
  • Auteur
Posté(e)

A défaut de réussir à le rentrer en valeur 250 j'ai changé pour l'écrire sous forme 0.25 mais ma polyligne se trace en arrondissant (ep=0.3) j'ai mis mes questions directement dans le code par ce que la je suis perdu ..

 

Merci à ceux qui participeront encore une fois ..

 

A savoir que j'ai montré ça à mon prof pour qu'il m'explique plus et sa réponse est "Mais il y à pleins de truc qui sert à rien la c'est nul" SUPER l’éducation nationale .. et il ne comprend pas l'utilité d'initialiser les valeur à coté de (defun c:conduite ( / blabla)) SUPER non ? <_<

 

 

 

(defun c:conduite ( / AcDoc Space msg_f msg_n n old_cutmnu old_plw old_osm pt_f lst_pt lst_tmp pt_n nw_pl key htx nw_style nw_obj pt rtx dxf_ent tmp deriv)
 (setq
   AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   Space
   (if (eq (getvar "CVPORT") 1)
     (vla-get-PaperSpace AcDoc)
     (vla-get-ModelSpace AcDoc)
   )
   msg_f "\nSpécifiez l'extrémité de la ligne ou [annUler]: "
   msg_n "\nSpécifiez l'extrémité de la ligne ou [Clore/annUler]: "
   n 0
   old_cutmnu (getvar "SHORTCUTMENU")
   old_plw (getvar "PLINEWID")
   old_osm (getvar "OSMODE")
 )
 (setvar "OSMODE" 5)
 (while (null (setq pt_f (getpoint "\nSpécifiez le point de départ de la polyligne: ")))
   (princ "\nPoint incorrect.")
 )
 (setq pt_f (trans pt_f 1 0) lst_pt (list pt_f) lst_tmp lst_pt)
 (setvar "LASTPOINT" (car lst_pt))
 (initget "U ANNUler _Undo UNDO")
 (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close"))
   (if (listp pt_n)
     (progn
       (setq pt_n (trans pt_n 1 0) lst_pt (cons pt_n lst_pt) lst_tmp lst_pt)
       (setvar "LASTPOINT" (car lst_pt))
       (setq n (1+ n) pt_f pt_n)
     )
     (if (zerop n)
       (princ "\nTous les segments sont déjà annulés.")
       (progn
         (setq lst_pt (cdr lst_pt) lst_tmp lst_pt)
         (setvar "LASTPOINT" (car lst_pt))
         (setq n (1- n) pt_f (getvar "lastpoint"))
       )
     )
   )
   (if (< n 1)
     (initget "U ANNUler _Undo UNDO")
     (initget "U ANNUler Clore _Undo UNDO Close")
   )
   (redraw)
   (while (cdr lst_tmp) (grdraw (trans (car lst_tmp) 0 1) (trans (cadr lst_tmp) 0 1) 7) (setq lst_tmp (cdr lst_tmp)))
 )
 (redraw)
 (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pt) (mapcar 'cadr lst_pt)))))
 (if (eq pt_n "Close")
   (vlax-put nw_pl 'Closed 1)
 )
 (setvar "SHORTCUTMENU" 11)
 (setvar "PLINEWID" 0.0)
 (if (not (eq (substr (getvar "USERS1") 1 3) "plw"))
   (setvar "USERS1" "plw0")
 )
(initget 4)
 (setq key (getreal (strcat "\nDiamètre souhaité (Epaisseur de la polyligne canalisation en Metre) <" (itoa (fix (* 100 (atof (substr (getvar "USERS1") 4 3))))) ">?: ")))
 (if key (setvar "USERS1" (strcat "plw" (rtos Key 2 1)))) ;                Initialise le diamètre à key    DIAMETRE A RENTRER EN METRE     PROBLEME DE RETRANSCRIPTION SI DIAMETRE 250 ALORS IL M'AFFICHERA EN TEXTE 300
 (vlax-put nw_pl 'ConstantWidth (atof (substr (getvar "USERS1") 4 3)))  ;   LA CANALISATION SE MET DONC EN 0.3 AU LIEU DE 0.25
 (initget "PVC BETON PEHD")
 (setq key (getkword "\nType de conduite [PVC/BETON/PEHD]?: "));           Initialise le type de conduite à KEY
 (cond
   ((null (tblsearch "LAYER" (strcat "Conduite-" key)))                         ;
     (vla-add (vla-get-layers AcDoc) (strcat "Conduite-" key))                  ;
   )                                                                            ;  Il faudrait pouvoir le mettre directement dans un calque prédéfini " CANALISATION" 
 )                                                                              ;
 (vlax-put nw_pl 'Layer (strcat "Conduite-" key))                               ;
 (cond                                                                          ;
   ((null (tblsearch "STYLE" "CONDUITE"))                                       ;
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "CONDUITE"))            ;
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
     )
   )
 );;;;;;;;;;;;;;;;;;;;;;;
 (initget 6)
 (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) ; Donner la hauteur du texte
 (if htx (setvar "TEXTSIZE" htx))
 (setq nw_obj
   (vla-addMtext Space
     (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE"))))
     (setq rtx 0.0)
           (strcat key ; Utilise key le type de conduite pour écrire le texte
       " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte
       " %%C:" "%<\\AcObjProp Object(%<\\_ObjId "
       (itoa (vla-get-ObjectID nw_pl))
       ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original
       " L = " "%<\\AcObjProp Object(%<\\_ObjId "
       (itoa (vla-get-ObjectID nw_pl))
       ">%).Length \\f \"%lu2%pr1\">%" "m"
     )
   )
 )
 (mapcar
   '(lambda (pr val)
     (vlax-put nw_obj pr val)
   )
   (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)	;   IL ME FAUDRAIT METTRE LE TEXTE DANS LE CALQUE QUI LUI EST PROPRE
   (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" (strcat "Conduite-" key) rtx)				; IMPOSSIBLE DE TROUVER COMMENT DECALER PLUS LE TEXTE PAR RAPPORT A LA POLYLIGNE
 (setq dxf_ent (entget (entlast)))									; ARRIVE A UNE CERTAINE VALEUR, LE TEXTE EST ILLISIBLE, MORDU PAR LA POLYLIGNE
 (while (or (= 5 (car (setq tmp (grread t 5 1)))) (/= (car tmp) 25) (= (car tmp) 3))
   (cond
     ((= 5 (car tmp))
       (setq
         pt (vlax-curve-getClosestPointTo nw_pl (trans (cadr tmp) 1 0))
         deriv (vlax-curve-getFirstDeriv nw_pl (vlax-curve-GetParamAtPoint nw_pl pt))
         rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
       )
       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
       (entmod
         (subst
           (cons 50 rtx)
           (assoc 50 dxf_ent)
           (subst (cons 10 (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))) (assoc 10 dxf_ent) dxf_ent)
         )
       )
       (entupd (cdar dxf_ent))
     )
     ((= 3 (car tmp))
       (setq nw_obj
         (vla-addMtext Space
           (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE"))))
           (setq rtx 0.0)
           (strcat "Conduite-" key " %%C:" "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID nw_pl))
             ">%).ConstantWidth \\f \"%lu2%pr1\">%" " L = " "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID nw_pl))
             ">%).Length \\f \"%lu2%pr1\">%" "m"
           )
         )
       )
       (mapcar
         '(lambda (pr val)
           (vlax-put nw_obj pr val)
         )
         (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)		;   ??????
         (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" (strcat "Conduite-" key) rtx)				;
       )
       (setq dxf_ent (entget (entlast)))
     )
     (T (princ "\nArrêt anormal de la commande "))
   )
 )
 (entdel (entlast))
 (setvar "PLINEWID" old_plw)
 (setvar "SHORTCUTMENU" old_cutmnu)
 (setvar "OSMODE" old_osm)
 (princ)
)

“L'environnement est important, pour sauver un arbre, mangez un castor !”

Lien vers le commentaire
Partager sur d’autres sites
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)
A savoir que j'ai montré ça à mon prof pour qu'il m'explique plus et sa réponse est "Mais il y à pleins de truc qui sert à rien la c'est nul" SUPER l’éducation nationale .. et il ne comprend pas l'utilité d'initialiser les valeur à coté de (defun c:conduite ( / blabla)) SUPER non ?

 

Je ne suis par contre les remarques, mais il faut qu'elles soient argumentées... car vu que tu a repris presque intégralement mon code, je me sens visé.

 

(defun c:conduite ( / blabla)): blabla ne sert pas à initialiser des variables, mais à les rendre locales.

C'est à dire quand le programme est achevé, la variable blabla est remise à nil, autrement elle garde sa valeur même en dehors du programme. C'est une façon beaucoup plus propre qui économise la mémoire et évite des interactions avec d'autres programmes qui aurait l'utilisation des même nom de variables.

 

Essayes la correction!

 

(defun c:conduite ( / AcDoc Space msg_f msg_n n old_cutmnu old_plw old_osm pt_f lst_pt lst_tmp pt_n nw_pl key htx nw_style nw_obj pt rtx dxf_ent tmp deriv)
 (setq
   AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   Space
   (if (eq (getvar "CVPORT") 1)
     (vla-get-PaperSpace AcDoc)
     (vla-get-ModelSpace AcDoc)
   )
   msg_f "\nSpécifiez l'extrémité de la ligne ou [annUler]: "
   msg_n "\nSpécifiez l'extrémité de la ligne ou [Clore/annUler]: "
   n 0
   old_cutmnu (getvar "SHORTCUTMENU")
   old_plw (getvar "PLINEWID")
   old_osm (getvar "OSMODE")
 )
 (setvar "OSMODE" 5)
 (while (null (setq pt_f (getpoint "\nSpécifiez le point de départ de la polyligne: ")))
   (princ "\nPoint incorrect.")
 )
 (setq pt_f (trans pt_f 1 0) lst_pt (list pt_f) lst_tmp lst_pt)
 (setvar "LASTPOINT" (car lst_pt))
 (initget "U ANNUler _Undo UNDO")
 (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close"))
   (if (listp pt_n)
     (progn
       (setq pt_n (trans pt_n 1 0) lst_pt (cons pt_n lst_pt) lst_tmp lst_pt)
       (setvar "LASTPOINT" (car lst_pt))
       (setq n (1+ n) pt_f pt_n)
     )
     (if (zerop n)
       (princ "\nTous les segments sont déjà annulés.")
       (progn
         (setq lst_pt (cdr lst_pt) lst_tmp lst_pt)
         (setvar "LASTPOINT" (car lst_pt))
         (setq n (1- n) pt_f (getvar "lastpoint"))
       )
     )
   )
   (if (< n 1)
     (initget "U ANNUler _Undo UNDO")
     (initget "U ANNUler Clore _Undo UNDO Close")
   )
   (redraw)
   (while (cdr lst_tmp) (grdraw (trans (car lst_tmp) 0 1) (trans (cadr lst_tmp) 0 1) 7) (setq lst_tmp (cdr lst_tmp)))
 )
 (redraw)
 (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pt) (mapcar 'cadr lst_pt)))))
 (if (eq pt_n "Close")
   (vlax-put nw_pl 'Closed 1)
 )
 (setvar "SHORTCUTMENU" 11)
 (setvar "PLINEWID" 0.0)
 (if (not (eq (substr (getvar "USERS1") 1 3) "plw"))
   (setvar "USERS1" "plw0.0")
 )
 (initget 4)
 (setq key (getreal (strcat "\nDiamètre souhaité (Epaisseur de la polyligne canalisation en Centimètre) <" (itoa (fix (atof (substr (getvar "USERS1") 4 5)))) ">?: ")))
 (if key (setvar "USERS1" (strcat "plw" (rtos Key 2 1))))                          ; Initialise le diamètre à key
                                                                                   ; DIAMETRE A RENTRER EN METRE
                                                                                   ; PROBLEME DE RETRANSCRIPTION SI DIAMETRE 250 ALORS IL M'AFFICHERA EN TEXTE 300
 (vlax-put nw_pl 'ConstantWidth (* (atof (substr (getvar "USERS1") 4 5)) 0.001))   ; LA CANALISATION SE MET DONC EN 0.3 AU LIEU DE 0.25
 (initget "PVC BETON PEHD")
 (setq key (getkword "\nType de conduite [PVC/BETON/PEHD]?: "))                    ; Initialise le type de conduite à KEY
 (cond
   ((null (tblsearch "LAYER" "CANALISATION"))                         ;
     (vla-add (vla-get-layers AcDoc) "CANALISATION")                  ;
   )                                                                  ; Il faudrait pouvoir le mettre directement dans un calque prédéfini " CANALISATION" 
 )                                                                    ;
 (vlax-put nw_pl 'Layer "CANALISATION")                               ;
 (cond                                                                ;
   ((null (tblsearch "STYLE" "CONDUITE"))                             ;
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "CONDUITE"))  ;
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
     )
   )
 )
 (initget 6)
 (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) ; Donner la hauteur du texte
 (if htx (setvar "TEXTSIZE" htx))
 (setq nw_obj
   (vla-addMtext Space
     (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE"))))
     (setq rtx 0.0)
     (strcat
       key
       " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte
       " %%C:"
       "%<\\AcObjProp Object(%<\\_ObjId "
       (itoa (vla-get-ObjectID nw_pl))
       ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original
       " L = " "%<\\AcObjProp Object(%<\\_ObjId "
       (itoa (vla-get-ObjectID nw_pl))
       ">%).Length \\f \"%lu2%pr1\">%" "m"
     )
   )
 )
 (mapcar
   '(lambda (pr val)
     (vlax-put nw_obj pr val)
   )
   (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)  ;IL ME FAUDRAIT METTRE LE TEXTE DANS LE CALQUE QUI LUI EST PROPRE
   (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" "CANALISATION" rtx)
 )                                                                                                ; IMPOSSIBLE DE TROUVER COMMENT DECALER PLUS LE TEXTE PAR RAPPORT A LA POLYLIGNE
 (setq dxf_ent (entget (entlast)))                                                                ; ARRIVE A UNE CERTAINE VALEUR, LE TEXTE EST ILLISIBLE, MORDU PAR LA POLYLIGNE
 (while (or (= 5 (car (setq tmp (grread t 5 1)))) (/= (car tmp) 25) (= (car tmp) 3))
   (cond
     ((= 5 (car tmp))
       (setq
         pt (vlax-curve-getClosestPointTo nw_pl (trans (cadr tmp) 1 0))
         deriv (vlax-curve-getFirstDeriv nw_pl (vlax-curve-GetParamAtPoint nw_pl pt))
         rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
       )
       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
       (entmod
         (subst
           (cons 50 rtx)
           (assoc 50 dxf_ent)
           (subst (cons 10 (polar pt (+ rtx (* pi 0.5)) (+ (* (atof (substr (getvar "USERS1") 4 5)) 0.001) (getvar "TEXTSIZE")))) (assoc 10 dxf_ent) dxf_ent)
         )
       )
       (entupd (cdar dxf_ent))
     )
     ((= 3 (car tmp))
       (setq nw_obj
         (vla-addMtext Space
           (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (+ (* (atof (substr (getvar "USERS1") 4 5)) 0.001) (getvar "TEXTSIZE")))))
           (setq rtx 0.0)
           (strcat
             key
             " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte
             " %%C:"
             "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID nw_pl))
             ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original
             " L = " "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID nw_pl))
             ">%).Length \\f \"%lu2%pr1\">%" "m"
           )
         )
       )
       (mapcar
         '(lambda (pr val)
           (vlax-put nw_obj pr val)
         )
         (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
         (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" "CANALISATION" rtx)
       )
       (setq dxf_ent (entget (entlast)))
     )
     (T (princ "\nArrêt anormal de la commande "))
   )
 )
 (entdel (entlast))
 (setvar "PLINEWID" old_plw)
 (setvar "SHORTCUTMENU" old_cutmnu)
 (setvar "OSMODE" old_osm)
 (princ)
)

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
Red Newbie

Red

Posté(e)
  • Auteur
Posté(e)

Je ne suis par contre les remarques, mais il faut qu'elles soient argumentées... car vu que tu a repris presque intégralement mon code, je me sens visé.

 

(defun c:conduite ( / blabla)): blabla ne sert pas à initialiser des variables, mais à les rendre locales.

C'est à dire quand le programme est achevé, la variable blabla est remise à nil, autrement elle garde sa valeur même en dehors du programme. C'est une façon beaucoup plus propre qui économise la mémoire et évite des interactions avec d'autres programmes qui aurait l'utilisation des même nom de variables.

 

Essayes la correction!

 

(defun c:conduite ( / AcDoc Space msg_f msg_n n old_cutmnu old_plw old_osm pt_f lst_pt lst_tmp pt_n nw_pl key htx nw_style nw_obj pt rtx dxf_ent tmp deriv)
 (setq
   AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
   Space
   (if (eq (getvar "CVPORT") 1)
     (vla-get-PaperSpace AcDoc)
     (vla-get-ModelSpace AcDoc)
   )
   msg_f "\nSpécifiez l'extrémité de la ligne ou [annUler]: "
   msg_n "\nSpécifiez l'extrémité de la ligne ou [Clore/annUler]: "
   n 0
   old_cutmnu (getvar "SHORTCUTMENU")
   old_plw (getvar "PLINEWID")
   old_osm (getvar "OSMODE")
 )
 (setvar "OSMODE" 5)
 (while (null (setq pt_f (getpoint "\nSpécifiez le point de départ de la polyligne: ")))
   (princ "\nPoint incorrect.")
 )
 (setq pt_f (trans pt_f 1 0) lst_pt (list pt_f) lst_tmp lst_pt)
 (setvar "LASTPOINT" (car lst_pt))
 (initget "U ANNUler _Undo UNDO")
 (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close"))
   (if (listp pt_n)
     (progn
       (setq pt_n (trans pt_n 1 0) lst_pt (cons pt_n lst_pt) lst_tmp lst_pt)
       (setvar "LASTPOINT" (car lst_pt))
       (setq n (1+ n) pt_f pt_n)
     )
     (if (zerop n)
       (princ "\nTous les segments sont déjà annulés.")
       (progn
         (setq lst_pt (cdr lst_pt) lst_tmp lst_pt)
         (setvar "LASTPOINT" (car lst_pt))
         (setq n (1- n) pt_f (getvar "lastpoint"))
       )
     )
   )
   (if (< n 1)
     (initget "U ANNUler _Undo UNDO")
     (initget "U ANNUler Clore _Undo UNDO Close")
   )
   (redraw)
   (while (cdr lst_tmp) (grdraw (trans (car lst_tmp) 0 1) (trans (cadr lst_tmp) 0 1) 7) (setq lst_tmp (cdr lst_tmp)))
 )
 (redraw)
 (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pt) (mapcar 'cadr lst_pt)))))
 (if (eq pt_n "Close")
   (vlax-put nw_pl 'Closed 1)
 )
 (setvar "SHORTCUTMENU" 11)
 (setvar "PLINEWID" 0.0)
 (if (not (eq (substr (getvar "USERS1") 1 3) "plw"))
   (setvar "USERS1" "plw0.0")
 )
 (initget 4)
 (setq key (getreal (strcat "\nDiamètre souhaité (Epaisseur de la polyligne canalisation en Centimètre) <" (itoa (fix (atof (substr (getvar "USERS1") 4 5)))) ">?: ")))
 (if key (setvar "USERS1" (strcat "plw" (rtos Key 2 1))))                          ; Initialise le diamètre à key
                                                                                   ; DIAMETRE A RENTRER EN METRE
                                                                                   ; PROBLEME DE RETRANSCRIPTION SI DIAMETRE 250 ALORS IL M'AFFICHERA EN TEXTE 300
 (vlax-put nw_pl 'ConstantWidth (* (atof (substr (getvar "USERS1") 4 5)) 0.001))   ; LA CANALISATION SE MET DONC EN 0.3 AU LIEU DE 0.25
 (initget "PVC BETON PEHD")
 (setq key (getkword "\nType de conduite [PVC/BETON/PEHD]?: "))                    ; Initialise le type de conduite à KEY
 (cond
   ((null (tblsearch "LAYER" "CANALISATION"))                         ;
     (vla-add (vla-get-layers AcDoc) "CANALISATION")                  ;
   )                                                                  ; Il faudrait pouvoir le mettre directement dans un calque prédéfini " CANALISATION" 
 )                                                                    ;
 (vlax-put nw_pl 'Layer "CANALISATION")                               ;
 (cond                                                                ;
   ((null (tblsearch "STYLE" "CONDUITE"))                             ;
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "CONDUITE"))  ;
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
     )
   )
 )
 (initget 6)
 (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) ; Donner la hauteur du texte
 (if htx (setvar "TEXTSIZE" htx))
 (setq nw_obj
   (vla-addMtext Space
     (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE"))))
     (setq rtx 0.0)
     (strcat
       key
       " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte
       " %%C:"
       "%<\\AcObjProp Object(%<\\_ObjId "
       (itoa (vla-get-ObjectID nw_pl))
       ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original
       " L = " "%<\\AcObjProp Object(%<\\_ObjId "
       (itoa (vla-get-ObjectID nw_pl))
       ">%).Length \\f \"%lu2%pr1\">%" "m"
     )
   )
 )
 (mapcar
   '(lambda (pr val)
     (vlax-put nw_obj pr val)
   )
   (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)  ;IL ME FAUDRAIT METTRE LE TEXTE DANS LE CALQUE QUI LUI EST PROPRE
   (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" "CANALISATION" rtx)
 )                                                                                                ; IMPOSSIBLE DE TROUVER COMMENT DECALER PLUS LE TEXTE PAR RAPPORT A LA POLYLIGNE
 (setq dxf_ent (entget (entlast)))                                                                ; ARRIVE A UNE CERTAINE VALEUR, LE TEXTE EST ILLISIBLE, MORDU PAR LA POLYLIGNE
 (while (or (= 5 (car (setq tmp (grread t 5 1)))) (/= (car tmp) 25) (= (car tmp) 3))
   (cond
     ((= 5 (car tmp))
       (setq
         pt (vlax-curve-getClosestPointTo nw_pl (trans (cadr tmp) 1 0))
         deriv (vlax-curve-getFirstDeriv nw_pl (vlax-curve-GetParamAtPoint nw_pl pt))
         rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
       )
       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
       (entmod
         (subst
           (cons 50 rtx)
           (assoc 50 dxf_ent)
           (subst (cons 10 (polar pt (+ rtx (* pi 0.5)) (+ (* (atof (substr (getvar "USERS1") 4 5)) 0.001) (getvar "TEXTSIZE")))) (assoc 10 dxf_ent) dxf_ent)
         )
       )
       (entupd (cdar dxf_ent))
     )
     ((= 3 (car tmp))
       (setq nw_obj
         (vla-addMtext Space
           (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (+ (* (atof (substr (getvar "USERS1") 4 5)) 0.001) (getvar "TEXTSIZE")))))
           (setq rtx 0.0)
           (strcat
             key
             " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte
             " %%C:"
             "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID nw_pl))
             ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original
             " L = " "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa (vla-get-ObjectID nw_pl))
             ">%).Length \\f \"%lu2%pr1\">%" "m"
           )
         )
       )
       (mapcar
         '(lambda (pr val)
           (vlax-put nw_obj pr val)
         )
         (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
         (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" "CANALISATION" rtx)
       )
       (setq dxf_ent (entget (entlast)))
     )
     (T (princ "\nArrêt anormal de la commande "))
   )
 )
 (entdel (entlast))
 (setvar "PLINEWID" old_plw)
 (setvar "SHORTCUTMENU" old_cutmnu)
 (setvar "OSMODE" old_osm)
 (princ)
)

 

 

Je vais essayer ça MERCI.

 

Oui je trouve ça totalement abérant que le simple fait d'initialiser les variable lui soit inconnu et qu'il n'en voie pas l'utilité .. je suis un peu déçu des réponses de mon prof <_< je ne remettrai pas son expérience en cause mais bon quand je vois ce que vous faites sur le forum en comparaison de lui et ben il n'y à pas photo <_<

“L'environnement est important, pour sauver un arbre, mangez un castor !”

Lien vers le commentaire
Partager sur d’autres sites
Patrick_35 Newbie

Patrick_35

Posté(e)
Posté(e)

Oui je trouve ça totalement abérant que le simple fait d'initialiser les variable lui soit inconnu et qu'il n'en voie pas l'utilité .. je suis un peu déçu des réponses de mon prof <_< je ne remettrai pas son expérience en cause mais bon quand je vois ce que vous faites sur le forum en comparaison de lui et ben il n'y à pas photo <_<

Salut

 

Invite-le sur le forum. On serait ravi d'échanger avec lui :D

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites
Red Newbie

Red

Posté(e)
  • Auteur
Posté(e)

A la fin de l'année il part a la retraite et il nous a fait comprendre qu'il n'allait pas se prendre la tête avec nous alors qu'il lui reste 3 mois avant de partir ????

“L'environnement est important, pour sauver un arbre, mangez un castor !”

Lien vers le commentaire
Partager sur d’autres sites
Patrick_35 Newbie

Patrick_35

Posté(e)
Posté(e)

A la fin de l'année il part a la retraite et il nous a fait comprendre qu'il n'allait pas se prendre la tête avec nous alors qu'il lui reste 3 mois avant de partir ????

Ce n'est pas une raison pour gâcher une année d'études.

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites
Red Newbie

Red

Posté(e)
  • Auteur
Posté(e)

Ce n'est pas une raison pour gâcher une année d'études.

 

@+

 

Malheureusement il y à des gens qui n'ont pas cette conscience professionnelle ...

“L'environnement est important, pour sauver un arbre, mangez un castor !”

Lien vers le commentaire
Partager sur d’autres sites
  • 4 semaines après...
Red Newbie

Red

Posté(e)
  • Auteur
Posté(e)

Bonjour bonjour, petit déterrage de post :P

 

Je viens aujourd'hui de faire mon lisp avec toutes mes commandes, mis en place une palette d'outil et tout et tout, tout marche bien mais la ... le drame, je passe exactement les même fichiers sur le poste de mon chef et la une variable (vlax-get-acad-object) n'est pas connue donc la commande s'arrête ..

 

Je pense avoir identifié le problème mais ne sait pas comment le résoudre, je travaille moi sur AUTOCAD et mon chef sur AUTOCAD MAP, il y en aurait un d'entre vous qui connaîtrai comment passer un lisp autocad en map ?

“L'environnement est important, pour sauver un arbre, mangez un castor !”

Lien vers le commentaire
Partager sur d’autres sites
Red Newbie

Red

Posté(e)
  • Auteur
Posté(e)

Merci je vais essayer ça :)

 

Quand tu parle de début du code c'est ici ?

 

(defun c:conduite ( / AcDoc Space msg_f msg_n n old_cutmnu old_plw old_osm pt_f lst_pt lst_tmp pt_n nw_pl key htx nw_style nw_obj pt rtx dxf_ent tmp deriv)

(setq

AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)(vl-load-com))

Space

(if (eq (getvar "CVPORT") 1)

(vla-get-PaperSpace AcDoc)

(vla-get-ModelSpace AcDoc)

)

“L'environnement est important, pour sauver un arbre, mangez un castor !”

Lien vers le commentaire
Partager sur d’autres sites
(gile) Proficient

(gile)

Posté(e)
Posté(e)

Non, la fonction vl-load-com s'appelle directement sans arguments (et la fonction vla-get-ActiveDocument n'accepte qu'un seul argument).

 

Tu peux l'appeler avant la routine :

(vl-load-com)

(defun c:conduite (/ AcDoc Space)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space (if (eq (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc)
             )
 )
 ;;...
)

 

ou au début de la routine :

(defun c:conduite (/ AcDoc Space)
 (vl-load-com)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space (if (eq (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc)
             )
 )
 ;;...
)

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

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
 Partager
Aller sur la liste des sujets
×
×
  • 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é