Aller au contenu

Lisp bande d'etanchéité


Messages recommandés

Posté(e)

Bonjour.

J'utilise pour le moment la commande multiligne avec debut et fin fermé puis j'y apporte des hachures pour faire un "effet" bandes d'etanchéité.

Je voudrais savoir s'il existe un lisp qui pourrait faire la bande (dans le meme principe que la multiligne)mais avec des rayons de courbure lorsqu'on change de direction, et le remplir de hachures pleine bien perpendiculaire au double ligne.

merci d'avance

Posté(e)

Bonjour,

 

un petit schéma nous aiderait à comprendre la demande : on n'est pas tous des pros de l'étanchéité.

 

Sinon, pour la hachure, ça me semble difficile. Sauf erreur, cela me semble impossible d'avoir une hachure avec un angle variable, si elle doit être perpendiculaire aux doubles polylignes avec segments droits et courbes.

 

Je ne vois que tracer des segments et mettre dans un groupe. C'est ce qui ressemble le + à une hachure.

 

(vl-load-com)

;; MAKEGROUP
;; Crée un groupe sans nom avec les entités contenues dans la liste
;;
;; Argument
;; lst : liste des entités (ename)
;;
;; Retour
;; le groupe créé (ename) ou nil

(defun makegroup (lst / dict ind)
 (setq 
   dict (dictsearch (namedobjdict) "ACAD_GROUP")
   ind "GRP1"
 )
 (while (member (cons 3 ind) dict)
   (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4))))))
 )
 (dictadd
   (cdr (assoc -1 dict))
   ind
   (entmakex
     (append
       (list
         '(0 . "GROUP") '(100 . "AcDbGroup") '(300 . "TALUS") '(70 . 1) '(71 . 1)
       )
       (mapcar (function (lambda (x) (cons 340 x))) lst)
     )
   )
 )
)

(defun cs:line (PO PF / AcDoc Space)
 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc) 
             )
 )
 (vla-addLine
   Space
   (vlax-3d-point PO)
   (vlax-3d-point PF)
 )
)


(defun c:perpchem (/ CHEM D PAS LCHEM PK PM PT FDER PTDERIV PTG PTD LN LGR)
 ;; saisir les éléments de construction
 (command "_pline")
 (while (not (zerop (getvar "cmdactive"))) ;; permet une saisie illimitée
   (command pause)
 )
 (setq CHEM (vlax-ename->vla-object (entlast)))
 (setq D (getdist "\nDécalage : "))
 (setq PAS (getdist "\nPas : "))

 ;; faire 2 décalages
 (setq OF1 (vla-offset CHEM D))
 (setq LGR (cons (entlast) LGR))
 (setq OF2 (vla-offset CHEM (* -1 D)))
 (setq LGR (cons (entlast) LGR))

 ;; calculer la longueur du chemin
 (setq LCHEM (vlax-curve-getDistAtPoint CHEM (vlax-curve-getEndPoint CHEM)))

 (setq PK 0)
 (while (< PK LCHEM)
   ;; déterminer le paramètre au pk courant
   (setq PM (vlax-curve-getParamAtDist CHEM PK))
   ;; déterminer le point au pk courant
   (setq PT (vlax-curve-getPointAtDist CHEM PK))
   ;; déterminer la dérivée première
   (setq FDER (vlax-curve-getfirstderiv CHEM PM))
   ;; déterminer le point qui construit la tangente à la courbe au point PT
   (setq PTDERIV (mapcar '+ PT FDER))
   ;; déterminer les points perpendiculaires à PT à une distance D
   (setq PTG (polar PT (+ (angle PT PTDERIV) (/ pi 2)) D))
   (setq PTD (polar PT (- (angle PT PTDERIV) (/ pi 2)) D))
   ;; tracer la ligne
   (setq LN (cs:line PTD PTG))
   (setq LGR (cons (entlast) LGR))
   ;; passer au pk suivant
   (setq PK (+ PK PAS))
 )
 (makegroup LGR)
 (vla-erase CHEM)
 (princ)
)

 

Amicalement

Vincent

C'est au pied du mur que l'on reconnaît le maçon ! (Anonyme)

C’est en restant au pied du mur qu’on ne voit que le mur (Anonyme aussi)

Posté(e)

Bonjour _Zebulon,

 

Je ne travail pas dans l'étanchéité mais tu n'est pas loin de la bonne représentation.

Il manque "juste" le remplissage d'un espace sur deux. Par compte ce n'est pas la partie la plus facile à programmer et je n'ai pas ton niveau.

 

Olivier

Posté(e)

Il manque "juste" le remplissage d'un espace sur deux.

 

Dans ce cas, je dessine une polyligne avec une épaisseur qui va bien est je mets cette polyligne sur un calque dont le style de ligne est cache.

 

ça le fait, non ?

 

Amicalement

Vincent

C'est au pied du mur que l'on reconnaît le maçon ! (Anonyme)

C’est en restant au pied du mur qu’on ne voit que le mur (Anonyme aussi)

Posté(e)

Merci pour les réponses.

Pour le lisp, il faudrait (mais je ne sais pas si c'est faisable) à chaque changement de direction (apres avoir cliqué), que l'on ai un rayon qui s'affiche en fonction de l'angle ou on veut continuer (et non un angle vif comme actuellement), puis des hachures pleines et la ligne fermé à la fin ce serait bien

 

Le soucis avec la polylign est que ce n'est qu' "un trait epais" .

Je ne peux pas m'accrocher sur l'epaisseur du trait.

 

mais bon un dessin vous aidera je pense.

 

merci

post-15372-0-78582500-1417006017_thumb.jpg

Posté(e)

Bonjour,

 

dans le lisp fourni plus haut, quand on construit la polyligne, on peut faire des segments courbes.

 

Sinon, je pense que l'idée de la polylogne épaisse reste ce qu'il y a de plus simple. On fait une polyligne d'épaisseur D dont le style de ligne est "cache", on fait 2 décalages de D/2 qu'on met sur un style "Continuous" pour faire les bords. On pourra ainsi s'attacher, soit à l'axe, soit sur les côtés. On peut tout mettre dans un groupe, y compris les 2 petits segments qui ferment aux extrémités.

 

La question est de savoir : on part de quoi ?

- On clique sur un axe existant et le lisp habille cet axe

- On saisit des segments droits, le lisp crée des raccords entre chaque (valeur du rayon ? gestion d'erreur si le rayon est trop grand...) en fait un axe et habille le tout

- Nom des calques, couleurs etc...

 

Ci dessous un lisp pour dessiner une gaine à partir d'un axe

 

;;;
;;; lancer une commande autocad

(defun mycmd (LCMD / CMD ETL LELEM RES OLDCMDECHO)
 (setq ETL (entlast))
 (setq OLDCMDECHO (getvar "CMDECHO"))
 (setvar "CMDECHO" 1)
 (foreach CMD LCMD
   (command CMD)
 )
 (while (not (zerop (getvar "cmdactive")))
   (command pause)
 )
 (setvar "CMDECHO" OLDCMDECHO)
 (setq LELEM nil)
 (if (not ETL) 
   (setq ETL (entnext))
   (setq ETL (entnext ETL))
 )
 (while ETL
   (setq LELEM (cons ETL LELEM))
   (setq ETL (entnext ETL))
 )
 (setq RES LELEM)
)


(defun c:chem_gaine (/ PLENAM PLOBJ OFFSETD OFFSETG PTOD PTFD PTOG PTFG AcDoc Space LO LF)
 (vl-load-com)
 ;; largeur de la polyligne
 (setq D (getreal "\nLargeur de la gaine : "))
 ;; tracer une polyligne
 (setq PLENAM (car (mycmd '("_pline"))))
 ;; transformer en vla-object
 (setq PLOBJ (vlax-ename->vla-object PLENAM))
 ;; faire les décallages
 (vla-offset PLOBJ (/ D 2.0))    ; à droite
 (setq OFFSETD (vlax-ename->vla-object (entlast)))
 (vla-offset PLOBJ (/ D -2.0))    ; à gauche
 (setq OFFSETG (vlax-ename->vla-object (entlast)))
 ;; effacer la polyligne d'origine
 ;; (vla-erase PLOBJ)
 ; fermer les extrémités avec des lignes
 (setq PTOD (vlax-curve-getStartPoint OFFSETD))
 (setq PTFD (vlax-curve-getEndPoint OFFSETD))
 (setq PTOG (vlax-curve-getStartPoint OFFSETG))
 (setq PTFG (vlax-curve-getEndPoint OFFSETG))

 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc) 
             )
 )
 (vla-addLine
   Space
   (vlax-3d-point PTOD)
   (vlax-3d-point PTOG)
 )
 (setq LO (entlast))
 (vla-addLine
   Space
   (vlax-3d-point PTFD)
   (vlax-3d-point PTFG)
 )
 (setq LF (entlast))
 ;; on fait un PEDIT "Joindre" avec tout ça
 (setvar "peditaccept" 1)
 (command "_pedit" "_m" LO (vlax-vla-object->ename OFFSETD) LF (vlax-vla-object->ename OFFSETG) "" "_j" 0.1 "_w" "0.0" "")
 (princ)
)

 

Amicalement

Vincent

C'est au pied du mur que l'on reconnaît le maçon ! (Anonyme)

C’est en restant au pied du mur qu’on ne voit que le mur (Anonyme aussi)

  • 7 ans après...
Posté(e)

  

Bonjour à tous,

Voulant réaliser la même chose que Iowa13. Je partage avec vous cette assemblage provenant de
différentes sources pour créer un LISP de bande d'étanchéité.

Je serai heureux de lire vos commentaires.

2098292498_Sanstitre.thumb.png.ec7865b21cb94dfbef2b5a9b6cb444ea.png

 Principal sources:

  • Lisp d'origine [bande d'étanchéité - de Zebulon]
  • Introduction a AutoLisp - Giles

Les modifications (douteuse) que j'ai apporté dans les grandes lignes:

  • Il y a certainement plus simple, mais je n'ai pas trouvé d'autre solution que de reporter une liste de points dans un fichier texte que
    je récupère juste après pour la commande _bhatch (hachurer)

Loin d'être parfait

  • Certaine hachure ne se réalise pas
  • La couleur de la hachure doit être sélectionner auparavant
  • Commence par un trait plein mais ne finis pas ainsi
  • Un fichier texte est générer à l'emplacement %HOMEPATH%
  • La définition du chemin n'est pas aisé
  • Et surtout moi (m'améliorer avec Visual Lisp, interface, programmation bas niveau une fois qui sait.. etc)

 

Voilà. Ce premier post a surtout pour but de passer le bonjour et de remercier la communauté. Un grand merci à Giles en particulier.

 

;-----------------------------------------------------------------------------------------;
; ---- Reprise du lisp proposé par Zebulon_ (Forum - CadXP - Lisp bande d'étanchéité) ----;
;-----------------------------------------------------------------------------------------;

(vl-load-com)

;; MAKEGROUP
;; Crée un groupe sans nom avec les entités contenues dans la liste
;;
;; Argument
;; lst : liste des entités (ename)
;;
;; Retour
;; le groupe créé (ename) ou nil

(defun makegroup (lst / dict ind)
 (setq 
   dict (dictsearch (namedobjdict) "ACAD_GROUP")
   ind "GRP1"
 )
 (while (member (cons 3 ind) dict)
   (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4))))))
 )
 (dictadd
   (cdr (assoc -1 dict))
   ind
   (entmakex
     (append
       (list
         '(0 . "GROUP") '(100 . "AcDbGroup") '(300 . "TALUS") '(70 . 1) '(71 . 1)
       )
       (mapcar (function (lambda (x) (cons 340 x))) lst)
     )
   )
 )
)

(defun cs:line (PO PF / AcDoc Space)
 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc) 
             )
 )
 (vla-addLine
   Space
   (vlax-3d-point PO)
   (vlax-3d-point PF)
 )
)

;------------------------------------------------------;
; ---- Rajout lst2str p.31 Introduction a AutoLisp ----;
;------------------------------------------------------;

(defun lst2str (lst sep)
  (if (cdr lst)
    (strcat (vl-princ-to-string (car lst))
    sep (lst2str (cdr lst) sep)
    )
    (vl-princ-to-string (car lst))
  )
)

;------------------------------------------------------;
; ---- Rajout str2lst p.31 Introduction a AutoLisp ----;
;------------------------------------------------------;

(defun str2lst (str sep / pos)
  (if 
    (setq pos (vl-string-search sep str))
    (cons (substr str 1 pos)
      (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)


(defun c:perpchem (/ CHEM D PAS LCHEM PK PM PT FDER PTDERIV PTG PTD LN LGR ptt k)
 ;; saisir les éléments de construction
 (command "_pline")
 (while (not (zerop (getvar "cmdactive"))) ;; permet une saisie illimitée
   (command pause)
 )
 (setq CHEM (vlax-ename->vla-object (entlast)))
 (setq D (getdist "\nDécalage : "))
 (setq PAS (* D 6))

 ;; faire 2 décalages
 (setq OF1 (vla-offset CHEM D))
 (setq LGR (cons (entlast) LGR))
 (setq OF2 (vla-offset CHEM (* -1 D)))
 (setq LGR (cons (entlast) LGR))

 ;; calculer la longueur du chemin
 (setq LCHEM (vlax-curve-getDistAtPoint CHEM (vlax-curve-getEndPoint CHEM)))

 (setq PK 0)
 (while (< PK LCHEM)
   ;; déterminer le paramètre au pk courant
   (setq PM (vlax-curve-getParamAtDist CHEM PK))
   ;; déterminer le point au pk courant
   (setq PT (vlax-curve-getPointAtDist CHEM PK))
   ;; déterminer la dérivée première
   (setq FDER (vlax-curve-getfirstderiv CHEM PM))
   ;; déterminer le point qui construit la tangente à la courbe au point PT
   (setq PTDERIV (mapcar '+ PT FDER))
    ;------------------------------------------------------------;
    ; ---- Crée une liste de point selon le pas div. par 2 ------;
    ;------------------------------------------------------------;
   (setq ptt (polar PT (angle PT PTDERIV) (/ PAS 2)))
   (setq lst (cons (append (list (car ptt)) (list (cadr ptt))) lst))
    ;------------------------- fin ------------------------------;
   ;; déterminer les points perpendiculaires à PT à une distance D
   (setq PTG (polar PT (+ (angle PT PTDERIV) (/ pi 2)) D))
   (setq PTD (polar PT (- (angle PT PTDERIV) (/ pi 2)) D))
   ;; tracer la ligne
   (setq LN (cs:line PTD PTG))
   (setq LGR (cons (entlast) LGR))
   ;; passer au pk suivant
   (setq PK (+ PK PAS))
 )
 (makegroup LGR)
 (vla-erase CHEM)
 ;----------------------------------------------------------------------------------------------------------;
 ; ---- convertion liste de point en fichier *.txt -> utiliser le fichier *.txt pour la command hachure ----;
 ; ---- hachurer un segment chaque 2 point -----------------------------------------------------------------;
 ;----------------------------------------------------------------------------------------------------------;
 (setq file (open "C:\\Users\\Yannick\\Points.txt" "w"))
 (foreach p (reverse lst)
   (write-line (lst2str p ",") file)
 )
 (close file)
 (if (findfile "C:\\Users\\Yannick\\Points.txt")
    (progn
      (setq file (open "C:\\Users\\Yannick\\Points.txt" "r"))
      (setq k 4)
      (while (setq line (read-line file))
        (if (= (rem k (/ k 2)) 0)
          (progn 
            (command "_bhatch" "p" "solid" (mapcar 'read (str2lst line ",")) "")
            (setq k (1+ k))
          )
          (setq k (1+ k))
        )
      )
      (close file)
    )
 (princ "\nLe fichier \"C:\\Points.txt\" est introuvable"))
 (setq lst ())
 (princ)
)

 

  • 1 mois après...
  • 8 mois après...

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é