Test premier message

[Atlas]

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.

 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 (Merci Gile!) ----;
;--------------------------------------------------------------------;

(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 (Merci Gile!) ----;
;--------------------------------------------------------------------;

(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)
)

[Atlas]

il y a une heure, Atlas a dit :

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.

 

https://cadxp.com/topic/48898-test-code/

 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.

test