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

Carroyage

Sansan

Par Sansan
dans AutoCAD LT 2024

 Partager

Messages recommandés

Sansan Newbie

Sansan

Posté(e)
Posté(e)

Bonjour à tous,

Étant novice sur AutoCAD, pouvez vous m'aider à réaliser un carroyage sur AutoCAD LT 2024 (je n'ai pas Covadis ou autres)...

Merci beaucoup pour votre aide 🙏

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

Hello

 

Tu peux utiliser ce qui est fourni avec AutoCAD CIVIL sur ton AutoCAD, ACAD MAP, ACAD Archi, etc ...

Routine Lisp :  C3D_CARROY

Et il faudra ajouter la Police "C3D.shx" dans tes Fonts/Polices AutoCAD ...

SVP tu nous signales si c OK sur ton AutoCAD LT 2024 et si cela te convient !?

 

Bruno  ( @bonuscad ) a aussi developpe un excellent Lisp qui fait un joli Carroyage mais je ne l ai pas sous la main a l instant T !

 

Belle Annee 2024, La Sante, Bye, lecrabe

C3D_CARROY___SHX.zip

  • Like 1

Autodesk Expert Elite Team

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

Hello

Et voici la routine "DIM-GRID" de Bruno  ( @bonuscad ) ...

SVP tu nous signales si c OK sur ton AutoCAD LT 2024 et si cela te convient !?

Bye, lecrabe

  

 
;; 
;; https://cadxp.com/topic/49297-un-carroyage/page__pid__295829#entry295829
;; 
;; Routine: DIM-GRID par Bonuscad
;; 
;; Dessin de carroyage Lambert
;; 
;; 
;; ---- Demande: SVP comment ajouter les Echelles a TA Liste : 150 , 400 , 1500 , 4000 , 15000
;; 
;; A la ligne 54 ou tu as: 
;;               l_scale '(1.0 1.25 2.0 2.5 5.0 7.5)
;; tu la passes a: 
;;               l_scale '(1.0 1.25 1.5 2.0 2.5 4.0 5.0 7.5)
;; 
;; C'est la liste unitaire des échelles, donc quand tu parle de 15000, c'est la même que 150 (ou 15 ou 1.5)
;; En appuyant sur "+", dès que tu arrives à la fin de la liste (un multiple de 7.5) , 
;; tu retournes au début de la liste en incrémentant avec un facteur de 10 et avec "-" avec un facteur de 0.1
;; Le code propose une échelle qui est calculée en conséquence d'un A4 suivant ton hauteur de vue actuelle (variable "VIEWSIZE"), 
;; donc : CONSEIL, ne pas trop s'écarter de l'échelle proposée au départ sous peine d'avoir un quadrillage très serré 
;; ou à l'inverse non visible car trop écarté. Passer par exemple de 7500000 à 7500 va donner un quadrillage très serré. 
;; Le mieux est de lancer la routine lorsque la partie que tu désires quadriller et visible entièrement à l'écran 
;; et de rester dans l'ordre de grandeur proposé 10, 100, 1000, 10000 etc ... 
;; 

(vl-load-com) 

(defun des_vec (lst col / lst_sg)
        (setq lst_sg (list (cadr lst) (car lst)))
        (setq lst (cdr lst))
        (while lst
                (if (cadr lst)
                        (setq lst_sg (cons (cadr lst) (cons (car lst) lst_sg)))
                        (setq lst_sg (cons (last lst_sg) (cons (car lst) lst_sg)))
                )
                (setq lst (cdr lst))
        )
        (setq lst_sg (cons col lst_sg))
        (grvecs lst_sg)
) 

(defun l-coor2l-pt (lst flag / )
        (if lst
                (cons (list (car lst) (cadr lst) (if flag (caddr lst) 0.0))
                        (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
                )
        )
) 

(defun c:DIM-GRID ( / unit_draw AcDoc Space UCS save_ucs WCS dx_u hview old_snapang pt_ins dx dy pt_tmp ang l_scale format_scale coeff
 key pt_key s_ang nw_style f_pat nw_pl ech htx nw_pl_out nw_pl_in hatch_out hatch lst_pt str ori_txt nw_txt)
        (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
                (setvar "USERS5" (strcat "qz" (itoa (setq unit_draw 1000))))
                (setq unit_draw (atoi (substr (getvar "USERS5") 3)))
        )
        (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
        (vla-StartUndoMark AcDoc)
        (setq
                Space
                (if (eq (getvar "CVPORT") 1)
                        (vla-get-PaperSpace AcDoc)
                        (vla-get-ModelSpace AcDoc)
                )
                UCS (vla-get-UserCoordinateSystems AcDoc)
                save_ucs
                (vla-add UCS
                        (vlax-3d-point '(0.0 0.0 0.0))
                        (vlax-3d-point (getvar "UCSXDIR"))
                        (vlax-3d-point (getvar "UCSYDIR"))
                        "CURRENT_UCS"
                )
        )
        (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG")))
        (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS"))
        (vla-put-activeUCS AcDoc WCS)
        (if (not dx_u) (setq dx_u 210.0))
        (setq
                hview (getvar "VIEWSIZE")
                old_snapang (getvar "SNAPANG")
                pt_ins (list (- (car (getvar "VIEWCTR")) (* hview 0.5)) (- (cadr (getvar "VIEWCTR")) (* hview 0.5)))
                dx dx_u dy (* dx_u (sqrt 2)) pt_tmp pt_ins ang (getvar "SNAPANG") 

;;              l_scale '(1.0 1.25 2.0 2.5 5.0 7.5) 
                l_scale '(1.0 1.25 1.5 2.0 2.5 4.0 5.0 7.5)  ;; Echelles supplementaires 

                format_scale (car l_scale)
                coeff 1.0
        )
        (if (> (fix (/ hview dy)) 3)
                (while (> (fix (/ hview dy)) 3)
                        (foreach value l_scale
                                (if (> (fix (/ hview dy)) 3)
                                        (setq format_scale value dx (* dx_u format_scale) dy (* dx_u (sqrt 2) format_scale))
                                )
                        )
                        (if (> (fix (/ hview dy)) 3)
                                (setq
                                        coeff (* coeff 10.0)
                                        l_scale (mapcar '(lambda (x) (* x coeff)) l_scale)
                                        format_scale (car l_scale)
                                )
                        )
                )
        )
        (if (< (fix (/ hview dy)) 1)
                (while (< (fix (/ hview dy)) 1)
                        (foreach value (reverse l_scale)
                                (if (< (fix (/ hview dy)) 1)
                                        (setq format_scale value dx (* dx_u format_scale) dy (* dx_u (sqrt 2) format_scale))
                                )
                        )
                        (if (< (fix (/ hview dy)) 1)
                                (setq
                                        coeff (* coeff 0.1)
                                        l_scale (mapcar '(lambda (x) (* x coeff)) l_scale)
                                        format_scale (last l_scale)
                                )
                        )
                )
        )
        (princ (strcat "\nSpecify up rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
        (while (and (setq key (grread T 4 0)) (/= (car key) 3))
                (cond
                        ((eq (car key) 5)
                                (setq pt_key (cadr key))
                                (redraw)
                                (setq
                                        dx (+ (* (- (car pt_key) (car pt_ins)) (cos ang)) (* (- (cadr pt_key) (cadr pt_ins)) (sin ang)))
                                        dy (- (* (- (cadr pt_key) (cadr pt_ins)) (cos ang)) (* (- (car pt_key) (car pt_ins)) (sin ang)))
                                )
                                (des_vec
                                        (list
                                                (list (car pt_ins) (cadr pt_ins))
                                                (list (+ (car pt_ins) (* dx (cos ang))) (+ (cadr pt_ins) (* dx (sin ang))))
                                                (setvar "LASTPOINT"
                                                        (list
                                                                (+ (car pt_ins) (- (* dx (cos ang)) (* dy (sin ang))))
                                                                (+ (cadr pt_ins) (+ (* dy (cos ang)) (* dx (sin ang))))
                                                        )
                                                )
                                                (list (- (car pt_ins) (* dy (sin ang))) (+ (cadr pt_ins) (* dy (cos ang))))
                                        )
                                        3
                                )
                        )
                        ((or (eq (cadr key) 114) (eq (cadr key) 82))
                                (initget 0)
                                (setq s_ang
                                        (getorient pt_ins
                                                (strcat
                                                        "\nNew angle<"
                                                        (angtos (getvar "SNAPANG"))
                                                        ">: "
                                                )
                                        )
                                )
                                (if (not s_ang) (setq s_ang ang))
                                (if (and (> s_ang (/ pi 2)) (<= s_ang (/ (* 3 pi) 2)))
                                        (setq ang (+ s_ang pi))
                                        (setq ang s_ang)
                                )
                                (setvar "SNAPANG" ang)
                                (princ (strcat "\nSpecify up rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
                        )
                        ((or (eq (cadr key) 112) (eq (cadr key) 80))
                                (initget 9)
                                (setq pt_ins (getpoint "\nSpecify down left corner: "))
                                (setq pt_ins (list (car pt_ins) (cadr pt_ins)))
                                (princ (strcat "\nSpecify up rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
                        )
                        ((eq (cadr key) 43)
                                (setq format_scale (cadr (member format_scale l_scale)))
                                (if (not format_scale) (setq format_scale (car (setq l_scale (mapcar '(lambda (x) (* x 10.0)) l_scale)))))
                                (setq dx (* dx_u format_scale) dy (* dx_u (sqrt 2) format_scale))
                                (princ (strcat "\nSpecify up rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
                        )
                        ((eq (cadr key) 45)
                                (setq format_scale (cadr (member format_scale (reverse l_scale))))
                                (if (not format_scale) (setq format_scale (last (setq l_scale (mapcar '(lambda (x) (* x 0.1)) l_scale)))))
                                (setq dx (* dx_u format_scale) dy (* dx_u (sqrt 2) format_scale))
                                (princ (strcat "\nSpecify up rigth corner or: [P] for new Position of down left corner,[R] for make Rotate, [+/-] change scale <" (rtos (* unit_draw format_scale) 2 3) ">: "))
                        )
                )
        )
        (princ "\n")
        (redraw)
        (if (not (tblsearch "STYLE" "$DIM-GRID"))
                (progn
                        (setq nw_style (vla-add (vla-get-textstyles AcDoc) "$DIM-GRID"))
                        (mapcar
                                '(lambda (pr val)
                                        (vlax-put nw_style pr val)
                                )
                                (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
                                (list "SIMPLEX.SHX" 0.0 0.0 1.0 0.0)
                        )
                )
  )
        (if (not (tblsearch "LAYER" "DIM-GRID"))
                (vlax-put (vla-add (vla-get-layers AcDoc) "DIM-GRID") 'color 7)
        )
        (if (not (findfile "QUADISO.pat"))
                (progn
                        (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\QUADISO.pat") "w"))
                        (write-line "*QUADISO,Quadrillage lambert" f_pat)
                        (write-line "0, -.015,0, 0,1, .03,-.97" f_pat)
                        (write-line "90, 0,-.015, 0,1, .03,-.97" f_pat)
                        (close f_pat)
                )
        )
        (if (not (findfile "REPQUADISO.pat"))
                (progn
                        (setq f_pat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\REPQUADISO.pat") "w"))
                        (write-line "*REPQUADISO,Repere du quadrillage lambert" f_pat)
                        (write-line "0, 0,0, 0,1" f_pat)
                        (write-line "90, 0,0, 0,1" f_pat)
                        (close f_pat)
                )
        )
        (setq
                nw_pl
                (vlax-invoke Space 'AddLightWeightPolyline
                        (append
                                pt_ins
                                (polar pt_ins (+ (getvar "SNAPANG") (* pi 0.5)) (* (distance pt_ins (getvar "LASTPOINT")) (sin (- (angle pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG")))))
                                
                                (list (car (getvar "LASTPOINT")) (cadr (getvar "LASTPOINT")))
                                (polar pt_ins (getvar "SNAPANG") (* (distance pt_ins (getvar "LASTPOINT")) (cos (- (angle pt_ins (getvar "LASTPOINT")) (getvar "SNAPANG")))))
                        )
                )
                ech (* unit_draw format_scale)
                htx (/ ech 500.0)
        )
        (vla-put-Closed nw_pl 1)
        (vla-put-layer nw_pl "DIM-GRID")
        (vla-Offset nw_pl (* htx 2.5))
        (setq nw_pl_out (vlax-ename->vla-object (entlast)))
        (vla-Offset nw_pl (+ (* htx 2.5) (* htx 10.0)))
        (setq nw_pl_in (vlax-ename->vla-object (entlast)))
        (setvar "HPORIGINMODE" 0)
        (setvar "HPORIGIN" '(0.0 0.0))
        (setq hatch_out (vla-AddHatch Space acHatchPatternTypeCustomDefined "REPQUADISO" :vlax-True))
        (vlax-invoke hatch_out 'AppendOuterLoop (list nw_pl))
        (vlax-invoke hatch_out 'AppendInnerLoop (list nw_pl_out))
        (vla-put-patternscale hatch_out (/ ech 10.0))
        (vla-put-patternangle hatch_out 0.0)
        (vla-put-layer hatch_out "DIM-GRID")
        (vla-evaluate hatch_out)
        (setq hatch (vla-AddHatch Space acHatchPatternTypeCustomDefined "QUADISO" :vlax-True))
        (vlax-invoke hatch 'AppendOuterLoop (list nw_pl_in))
        (vla-put-patternscale hatch (/ ech 10.0))
        (vla-put-patternangle hatch 0.0)
        (vla-put-layer hatch "DIM-GRID")
        (vla-evaluate hatch)
        (setq lst_pt
                (l-coor2l-pt
                        (vlax-invoke
                                hatch_out
                                'IntersectWith
                                nw_pl_out
                                acExtendThisEntity
                        )
                        T
                )
        )
        (foreach el lst_pt
                (cond
                        ((or (equal (rem (car el) (/ ech 10.0)) (/ ech 10.0) 1E-8) (equal (rem (car el) (/ ech 10.0)) 0.0 1E-8))
                                (setq str (strcat " " (rtos (car el) 2 0) " ") ori_txt (* pi 0.5))
                        )
                        ((or (equal (rem (cadr el) (/ ech 10.0)) (/ ech 10.0) 1E-8) (equal (rem (cadr el) (/ ech 10.0)) 0.0 1E-8))
                                (setq str (strcat " " (rtos (cadr el) 2 0) " ") ori_txt 0.0)
                        )
                        (T (setq str nil ori_txt nil))
                )
                (cond
                        ((and el str ori_txt)
                                (setq nw_txt (vla-AddText Space str (vlax-3d-point el) htx))
                                (vla-put-layer nw_txt "DIM-GRID")
                                (vla-put-StyleName nw_txt "$DIM-GRID")
                                (vla-put-Alignment nw_txt acAlignmentMiddleLeft)
                                (vla-put-Rotation nw_txt ori_txt)
                                (vla-put-TextAlignmentPoint nw_txt (vlax-3d-point el))
                                (if (vlax-invoke nw_pl 'IntersectWith nw_txt acExtendThisEntity)
                                        (vla-put-Alignment nw_txt acAlignmentMiddleRight)
                                )
                        )
                )
        )
        (setq pt_ins (polar pt_ins (+ (* pi 0.25) (getvar "SNAPANG")) (* htx 10)))
        (setq nw_txt (vla-AddText Space (strcat " Echelle 1/" (rtos ech 2 0)) (vlax-3d-point pt_ins) (* 2 htx)))
        (vla-put-layer nw_txt "DIM-GRID")
        (vla-put-StyleName nw_txt "$DIM-GRID")
        (vla-put-Alignment nw_txt acAlignmentMiddleLeft)
        (vla-put-Rotation nw_txt (getvar "SNAPANG"))
        (vla-put-TextAlignmentPoint nw_txt (vlax-3d-point pt_ins))
        (and save_ucs (vla-put-activeUCS AcDoc save_ucs))
        (and WCS (vla-delete WCS) (setq WCS nil))
        (vla-EndUndoMark AcDoc)
        (setvar "SNAPANG" old_snapang)
        (prin1)
)

 

  • Like 1

Autodesk Expert Elite Team

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Je joins la même fonction, mais celle ci est en Français: plus adapté pour ce forum...

J'en ai profité pour rajouter les échelles suggéré par @lecrabe

La première utilisation sera peut être déroutante. Il ne faut pas hésiter à bouger le curseur pour visualiser les formats virtuel de A4 assemblés à l'échelle proposée (ceci pour utiliser une plieuse de plan et pouvoir placer un page de garde cohérente au pliage) , et de même pour l'emplacement et/ou la rotation si tu veux un positionnement plus fin. La commande est validée dès que tu clique le coin haut droit.

carroyage.lsp

  • Like 1
  • Upvote 1

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Sansan Newbie

Sansan

Posté(e)
  • Auteur
Posté(e)
Il y a 21 heures, lecrabe a dit :

Hello

 

Tu peux utiliser ce qui est fourni avec AutoCAD CIVIL sur ton AutoCAD, ACAD MAP, ACAD Archi, etc ...

Routine Lisp :  C3D_CARROY

Et il faudra ajouter la Police "C3D.shx" dans tes Fonts/Polices AutoCAD ...

SVP tu nous signales si c OK sur ton AutoCAD LT 2024 et si cela te convient !?

 

Bruno  ( @bonuscad ) a aussi developpe un excellent Lisp qui fait un joli Carroyage mais je ne l ai pas sous la main a l instant T !

 

Belle Annee 2024, La Sante, Bye, lecrabe

C3D_CARROY___SHX.zip 6.07 Ko · 3 téléchargements

C'était pas gagné pour moi mais j'y suis arrivée grâce à vous !!

Un grand merci pour votre aide sans quoi j'y serais encore...

A bientôt (mais pas trop vite j'espère) pour de nouvelles aventures ^^

*Sansan 

lecrabe Mentor

lecrabe

Posté(e)
Posté(e)

Hello @Sansan

SVP peux tu nous dire quelles routines (parmi les 2) tu as testees ?

Etaient elles OK avec ton AutoCAD LT 2024 ?

Laquelle te convient le mieux ? Pourquoi ?

MERCI, Bye, lecrabe

 

Autodesk Expert Elite Team

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é