Classer Newbie! sur le forum, Cela me rajeunit (super). Bon, je suis un vieux.

Comme les hivers sont longs, humides et froids dans ma région, je me suis mis à nouveau à jouer avec AutoCAD et Revit, histoire d’entretenir mes neurones. Dans une autre vie je formais des techniciens de bureau d’études du bâtiment. J’ai ajouter un jouer, un logiciel en développement : MoI3D, pour le fun! 3D design et organique si l’on veut. La 3D m’a toujours passionné.

C’est un peu comme le sport la pratique logiciel : si l’on reprend après avoir arrêté un long moment, on souffre (plus ou moins…).

Je reviens donc vers mon forum favori.

Henri

Je suis à la recherche de symboles SSi normalisés

Recherches non satisfaisantes pour l'instant, auriez-vous ça en stock ? ou un site approprié ?

Vous en remerciant d'avance.

https://drive.google.com/drive/folders/10GVboAodPx9Qkny7yNTYXxL7slXj7gVV?usp=sharing

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

(defun asso (l1 l2 / massoc group)
 (defun massoc (k l)
   (if (setq l (member (assoc k l) l))
     (cons (cadar l) (massoc k (cdr l)))
   )
 )
 (defun group (l / k)
   (if (setq k (caar l))
     (cons (cons k (massoc k l))
           (group (vl-remove-if '(lambda (x) (= k (car x))) l))
     )
   )
 )
 (group (mapcar 'list l1 l2))
)

Avec une fonction auxillaire à recursion terminale (tail recursive) :

(defun asso (l1 l2 / loop)
 (defun loop (l1 l2 acc / sub)
   (if	l1
     (loop
(cdr l1)
(cdr l2)
(if (setq sub (assoc (car l1) acc))
  (subst (append sub (list (car l2))) sub acc)
  (cons (list (car l1) (car l2)) acc)
)
     )
     (reverse acc)
   )
 )
 (loop l1 l2 nil)
)

Si la machine LISP d'AutoCAD optimisait la recursion terminale, la fonction ci-dessus n'atteindrait jamais de "dépassement de la pile" (stack overflow) parce qu'elle serit interprétée comme la fonction itérative ci-dessous :

(defun asso (l1 l2 / sub res)
 (while l1
   (setq res (if (setq sub (assoc (car l1) res))
	(subst (append sub (list (car l2))) sub res)
	(cons (list (car l1) (car l2)) res)
      )
  l1  (cdr l1)
  l2  (cdr l2)
   )
 )
 (reverse res)
)

W567F? 7:3 W:X W4@?5 WWl : _X _X WWl : `X `X W% WZ W7:3 W\\ : `XX W7:3 W\\ : aXXXXXX

W567F? 7:3 W: ^ =@@AX W567F? =@@A W2 3 :X W:7 WK6C@A :X 2 W=@@A 3 WZ 2 3X W`\\ :XXXX W=@@A _ ` :XX

W567F? 7:3 W: ^ 2 3 4X WD6EB 2 _ 3 `X WD6EB 4 WZ 2 3X 2 3 3 4 : W`\\ :XXX 2X

Note aux lecteurs et à moi-même:

Donc étant propriétaire de tes codes, tu conserves une copie sur cadxp.

Et pour conserver tes codes, les dvb son protéger par mot de passe.

Comme ça, tes outils sont dispos gratuit et tu restes propriétaires des codes...

Attention pour ceux qui veulent télécharger le zip :

La bibliothèque et la base de données n'est pas incluses...

Je ne suis donc pas garant du bon fonctionnement du programme...

Je reste quand même à disposition pour les curieux (et attention c'est uniquement du VBA)

Edit "Le gestionnaire de présentation n'est pas à moi" le code reste donc opensource

20402029_DVBCURLY.zip

Je me permet de signaler un problème lorsque je souhaite apporter une réponse à un utilisateur.

Et ce n'est pas la première fois que je rencontre le problème. Sauf que Aujourd'hui j'ai réussi à faire passer ma réponse.

Je me connecte à mon profil et tape ma réponse.

Lorsque je valide la réponse, le bouton "Valider la réponse", il s'est transformé en "Enregistrement" et .... plus rien ne se passe!

J'ai recommencé plusieurs fois la manip, redémarré firefox... Toujours pareil

J'allais abandonner quand je me suis dit : Et si je désactivais mon bloqueur de publicité ? AdBlocker Ultimate est en effet installé.

Une fois désactivé, cela a marché du premier coup. Hasard ou pas ???

En tout cas, si vous lisez ce post, c'est que AdBlocker Ultimate est désactivé.... Non désactivé la première fois, la création de ce post a été impossible !

Cordialement

Au plaisir d'échanger conseils et astuces.

Amaury

IMPOSSIBLE de déplacer, j'en parle à Cadmin...

petit message à 2 balles pour vous dire que j'ai les yeux (et le cerveau) qui se croisent quand je vois l'un de vos pseudo ne sachant plus qui est qui sans avoir vu votre avatar

bravo aux nantais d'avoir choisit presque le même pseudo!! à mois que vous soyez né tous les deux en 44 😛

Phil

Édition du message mais pas de possibilité de déplacement

(defun jeu2 (s / l r)
 (setq l (vl-string->list s))
 (while (cdr l)
   (setq r (vl-list* (car l) (cadr l) r)
  l (cddr l)
   )
 )
 (vl-list->string r)
)

(defun jeu3 (str / f)
 (defun f (s r)
   (if	(< 1 (strlen s))
     (f (substr s 3) (strcat (substr s 1 2) r))
     r
   )
 )
 (f str "")
)

(defun jeu4 (s / r)
 (setq r "")
 (while (< 1 (strlen s))
   (setq r (strcat (substr s 1 2) r)
  s (substr s 3)
   )
 )
 r
)

(defun vlax-curve-getPolylineCoordinates (pl / i pts)
  (repeat (setq	i (if (vlax-curve-isClosed pl)
		    (fix (vlax-curve-getEndParam pl))
		    (1+ (fix (vlax-curve-getEndParam pl)))
		  )
	  )
    (setq pts (cons (vlax-curve-getPointAtParam pl (setq i (1- i))) pts))
  )
)

Sachez qu'avec 11 citations j'aie un message d’erreur. Je croie que la limite est à 10 citation par poste indépendamment de leur imbrication.

J'aie une réclamation : mettre la même couleur pour les niveaux 3 à 10, c'est de travail bâclé ! Vous auriez au moins pus répéter une boucle vert-rose-jaune à partie du niveau 4.

Et je me marre en pensant à ceux qui sont sur smartphone, ça doit être une de ces galère à afficher

j'espère que la communauté me pardonnera d'écrire encore un messge ou il mnque des lttrs!! :)

Phil

(entmake (list '(0 . "HATCH")
       '(5 . "289")
       '(100 . "AcDbEntity")
       '(67 . 0)
       '(410 . "Model")
       '(8 . "0")
       '(100 . "AcDbHatch")
       '(2 . "ANSI36")
       '(41 . 0.1)
       (cons 330 ent)))
)

Je reviens vers toi pcq j'ai pas sauvegarder le fichier (les 2 blocs) que tu utilises pour faire de la cotation alti, pourrais-tu me renvoyer le lien de téléchargement stp?

Jean-Philippe