Reprise de bétonnage

[CADZEB]

Bonjour,

 

Je me suis permis d'adapter le lisp de Zebulon_ concernant des reprises de bétonnage qu'on trouve ici. Je suis sûr qu'il ne m'en voudra pas. C'est pour la bonne cause.

 

Il y a toujours la fonction c:RB pour dessiner la reprise de bétonnage (j'ai rajouté un marqueur xdata pour reconnaitre cette polyligne parmi les autres). Il y a en plus une fonction c:RBMOD pour modifier la densité des zigzags et pour finir, il y a un réacteur pour modifier la reprise de bétonnage quand on étire la polyligne.

 

Pour la gestion des xdatas, j'utilise la bibliothèque crée et mise à disposition par

Didier DUHEM

 

(load "libdata")
(vl-load-com)

(defun create_xdata_rb (E / EXDATA)
 (setq EXDATA (x_putrel "dis" RB_DIST EXDATA "RBCADSYS"))
 (x_write EXDATA E "RBCADSYS")
)

(defun cs:LwPolyline (LISTPT LARGEUR LAY / ACDOC SPACE TABLEAU MyLwPolyline)
 (setq LISTPT (mapcar '(lambda (x) (list (car x) (cadr x))) LISTPT)) ;; enlever les z pour la lwpolyline
 (setq ACDOC (vla-get-activedocument (vlax-get-acad-object)))
 (setq SPACE
   (if (= (getvar "CVPORT") 1)
     (vla-get-PaperSpace ACDOC)
     (vla-get-ModelSpace ACDOC)
   )
 )
 ;; "transformer" les points en atomes avec append
 (setq LISTPT (apply 'append LISTPT))
 ;; créer le tableau
 (setq TABLEAU
   (vlax-make-safearray
     vlax-vbDouble
     (cons 0 (- (length LISTPT) 1))
   )
 )
 ;; remplir le tableau
 (vlax-safearray-fill TABLEAU LISTPT)
 ;; créer la polyline
 (setq MyLwPolyline (vla-addLightWeightPolyline SPACE TABLEAU))
 ;; lui coller une épaisseur
 (vla-put-ConstantWidth MyLwPolyline LARGEUR)
 ;; mettre dans un calque
 (vla-put-layer MyLwPolyline LAY)
 MyLwPolyline
)


(defun cs:startundomark ()
 (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
)

(defun cs:endundomark ()
 (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
)


(defun dessine_rb (PT1 PT2 RB_DIST LAY / ANG L H N RAB I LISTPT P2 P3 P4 RBPOL)
 (setq ANG (angle PT1 PT2))
 (setq L (distance PT1 PT2))
 (setq H (/ RB_DIST 2))
 (setq N (fix (/ (* 2 (+ L RB_DIST)) (* 3 RB_DIST))))
 (setq RAB (- (/ L 2) (* (/ RB_DIST 4) (- (* 3 N) 5))))

 (setq I 1)
 (setq LISTPT (list PT1))
 (repeat (- N 1)
   (if (= I 1)
     (setq P2 (polar PT1 ANG RAB))
     (setq P2 (polar PT1 ANG RB_DIST))
   )
   (setq LISTPT (cons P2 LISTPT))
   (setq P3 (polar P2 (+ ANG (atan 2)) (sqrt (/ (* 5 H H) 16))))
   (setq LISTPT (cons P3 LISTPT))
   (setq P4 (polar P3 (- ANG (atan 2)) (sqrt (/ (* 5 H H) 4))))
   (setq LISTPT (cons P4 LISTPT))
   (setq PT1 (polar P4 (+ ANG (atan 2)) (sqrt (/ (* 5 H H) 16))))
   (setq LISTPT (cons PT1 LISTPT))
   (setq I (+ I 1))
 )
 (setq LISTPT (cons PT2 LISTPT))
 (setq LISTPT (reverse LISTPT))

 (cs:LwPolyline LISTPT 0 LAY)
 (create_xdata_rb (entlast))
)

(defun C:RB (/ PT1 PT2)
 (cs:startundomark)
 (if (not RB_DIST)
   (cond
     ((= (getvar "INSUNITS") 4) (setq RB_DIST 50.0))     ;; mm
     ((= (getvar "INSUNITS") 5) (setq RB_DIST 5.0))      ;; cm
     ((= (getvar "INSUNITS") 14) (setq RB_DIST 0.5))     ;; dm
     ((= (getvar "INSUNITS") 6) (setq RB_DIST 0.05))     ;; m
     (T (setq RB_DIST 0.05))
   )
 )

 (setq PT1 nil)
 (prompt (strcat "\nEspace entre les symboles de reprise : " (rtos RB_DIST 2 3)))

 (while (/= (type PT1) 'LIST)
   (initget 1 "Espace")
   (setq PT1 (getpoint "\nPremier point ou [Espace] : "))
   (cond
     ((= PT1 "Espace")
       (setq RB_DIST (getdist "\nEspace entre les symboles de reprise : "))
     )
   )
 )
 (setq PT2 (getpoint PT1 "\nDeuxième point : "))
 (dessine_rb (trans PT1 1 0) (trans PT2 1 0) RB_DIST (getvar "CLAYER"))
 (cs:endundomark)
 (princ)
)

(defun C:RBMOD (/ ss RB_DIST I e eobj)
 (cs:startundomark)
 (prompt "\nSaisir les reprises de bétonnage à modifier :")
 (setq ss (ssget '((-3 ("RBCADSYS")))))
 (if ss
   (progn
     (setq RB_DIST (getdist "\nEspace entre les symboles de reprise : "))
     (setq I 0)
     (repeat (sslength ss)
       (setq e (ssname ss I))
       (setq eobj (vlax-ename->vla-object e))
       (dessine_rb 
         (vlax-curve-getStartPoint eobj)
         (vlax-curve-getEndPoint eobj)
          RB_DIST
         (vla-get-layer eobj)
       )
       (vla-delete eobj)
       (setq I (+ I 1))
     )
   )
 )
 (cs:endundomark)
 (princ)
)

(vlr-command-reactor "modifie RB" '((:vlr-commandEnded . EndStretchRB)))

(defun EndStretchRB (calling-reactor endcommandInfo / thecommandend ss ename eobj I RB_DIST)
 (setq thecommandend (nth 0 endcommandInfo))
 (if (or (= thecommandend "STRETCH") (= thecommandend "GRIP_STRETCH"))
   (progn
     (if (not (setq SS (cadr (ssgetfirst))))
       (setq ss (ssget "_P"))
     )
     (setq I 0)
     (if ss
       (repeat (sslength ss)
         (setq ename (ssname ss I))
         (if (setq RB_DIST (x_trouvinfo "dis" ENAME "RBCADSYS")) ;; quand j'ai créé la rb je lui ai mis un marqueur xdata pour la reconnaitre
           (progn
             (setq eobj (vlax-ename->vla-object ename))
             (dessine_rb 
               (vlax-curve-getStartPoint eobj)
               (vlax-curve-getEndPoint eobj)
               RB_DIST
               (vla-get-layer eobj)
             )
             (vla-delete eobj)
           )
         )
         (setq I (+ I 1))
       )
     )
   )
 )
)

 

Amicalement

Vincent

 

[Edité le 5/2/2010 par CADZEB]

[lili2006]

Bonjour à toutes et tous,

 

Testé et approuvé !

 

Cependant, sans mode d'accrochage, lorsqu'on lance "RBMOD", le 1er point part à "l'infinie",...

 

Je suis sûr qu'il ne m'en voudra pas. C'est pour la bonne cause.

 

J'espère aussi, :P

[CADZEB]

Cependant, sans mode d'accrochage, lorsqu'on lance "RBMOD", le 1er point part à "l'infinie",...

 

Je suis perplexe, comme le lisp n'utilise aucune (command ...), mais des vla-add qui ne sont pas "sensibles" aux accrochages aux objets.

Je n'arrive pas à reproduire le fonctionnement que tu décris

 

Amicalement

Vincent

 

[lili2006]

Re,

 

Je dois partir mais reviendrai sur ce post ce soir,...

 

Bonne fin de journée,

 

[lili2006]

Re,

 

Phénomène assez aléatoire mais qui existe,....

 

[CADZEB]

Bonjour,

 

là c'est clairement la fonction getdist qui a des sautes d'humeur. C'est au moment de la saisie de la distance que le curseur part à perpet et non lors de l'exécution de la fonction RBMOD. Dans mon esprit, compte tenu de ta première description du problème, je pensais que c'était le dessin de la reprise de bétonnage qui partait à l'infini.

 

Comme je n'utilise pas le mode de saisie dyn et que je rentre la distance en tapant une valeur au clavier, je n'étais pas prêt de retrouver ce comportement

 

J'ai essayé et je me suis mis en mode saisie dyn et je rentre la distance par 2 points. J'ai répété cette action une bonne vingtaine de fois et je n'ai pas eu de problème.

 

Je suis en version 2010, peut-être que cela a une importance ?

 

Par ailleurs, as-tu essayé le réacteur, en étirant la polyligne soit par une poignée, soit par la commande étirer ?

 

Amicalement

Vincent

 

[lili2006]

Bonjour à toutes et tous,

 

C'est au moment de la saisie de la distance que le curseur part à perpet et non lors de l'exécution de la fonction RBMOD. Dans mon esprit, compte tenu de ta première description du problème, je pensais que c'était le dessin de la reprise de bétonnage qui partait à l'infini.

 

Exact ! Je m'étais mal exprimé,....

 

Par ailleurs, as-tu essayé le réacteur, en étirant la polyligne soit par une poignée, soit par la commande étirer ?

 

Non !

 

Je teste ce soir et revient,...

[lili2006]

Re,

 

Même phénomène avec la commande "étirer",...(Là aussi, de façon aléatoire,...)

 

Par contre; nickel avec les poignées,.. :D

[CADZEB]

Bonjour,

 

peut-être est-ce un problème de souris qui, de temps en temps, t'envoie le curseur à perpet ? Parce que ce n'est pas, a priori, au niveau du lisp que ça bug : je suis incapable d'intervenir dans le fonctionnement de la fonction getdist. Idem pour la commande étirer.

 

Je ne vois pas. Si quelqu'un à une idée ?

 

Amicalement

Vincent

 

 

 

[CADZEB]

Par contre, je viens de m'apercevoir d'un oubli. Puisque je redessine la polyligne à chaque fois qu'elle est modifiée, il faut que je la remette sur le même caque que la polyligne d'origine. Sinon, elle se met sur le calque courant à chaque modification, ce qui n'est pas top.

 

Amicalement

Vincent

 

[lili2006]

Bonsoir à toutes et tous,

 

Bien vu ! :D

 

Oui, peut-être la souris, mais elle ne me fait jamais de coup comme ça,...

 

C'était plus une remarque pour toi qu'un problème d'utilisation pour moi,... :P

 

Vraiment super (ainsi que les réglages des échelles de lignes mais que je n'ai pas encore suffisamment testé,...).

 

Merci encore Vincent,