amélioration LISP gaines flexibles

[pascal19]

Bonjour à tous

 

J'utilise le LISP suivant pour faire des gaines flexibles, avec 3 points P1 P2 et P3,il me fait une partie droite et un coude. Mis en boucle je peux faire un réseau complet et d'apparence correcte.

Ma question: est-il possible d'avoir un aperçu de ma partie droite et de mon coude au moment

ou je dois donner P3, en fonction de la position du curseur?

 

 (DEFUN c:FLEX ()

 (SETQ d1 (getreal "\ndiametre en mm"))
 (setq H 1000.0)			;dessin sur plan en mètre
 (SETQ D (/ d1 H))

 (SETQ P1 (GETPOINT "\nPOINT DE DEPART PASCAL"))
 (SETQ P2 (GETPOINT "\nPOINT SUIVANT" P1))
 (SETQ A1 (ANGLE P1 P2))
 (SETQ P3 (GETPOINT "\nPOINT SUIVANT" P2))
 (SETQ A1 (ANGLE P1 P2))
 (SETQ A2 (ANGLE P2 P3))
 (SETQ A3 (+ A1 (/ pi 2)))
 (SETQ A4 (+ (+ pi A2) (/ pi 2)))
 (SETQ L1 (DISTANCE P1 P2))

 (SETQ L2 (DISTANCE P2 P3))
 (SETQ L3 (MIN (/ L1 2) (/ L2 2)))
 (SETQ P8 (polar P2 (+ pi A1) L3))
 (SETQ P9 (polar P2 A2 L3))
 (SETQ P4 (polar P1 A3 (/ D 2)))
 (SETQ P5 (polar P1 (+ pi A3) (/ D 2)))
 (SETQ P12 (polar P8 A3 (/ D 2)))
 (SETQ P10 (polar P8 (+ pi A3) (/ D 2)))
 (SETQ P13 (polar P9 A4 (/ D 2)))
 (SETQ P11 (polar P9 (+ pi A4) (/ D 2)))
 (SETQ P6 (polar P3 A4 (/ D 2)))
 (SETQ P7 (polar P3 (+ pi A4) (/ D 2)))



 (SETQ P0 (INTERS P12 P10 P13 P11 nil))
 (SETQ RA (DISTANCE P0 P8))
 (SETQ A5 (ANGLE P0 P8))
 (SETQ A6 (ANGLE P0 P2))
 (SETQ A7 (ANGLE P0 P9))
 (SETQ PA4 (polar P0 A5 RA))
 (SETQ PA5 (polar P0 A6 RA))
 (SETQ PA6 (polar P0 A7 RA))
 (SETQ PA1 (polar P0 A5 (- RA (/ D 2))))
 (SETQ PA2 (polar P0 A6 (- RA (/ D 2))))
 (SETQ PA3 (polar P0 A7 (- RA (/ D 2))))
 (SETQ PA7 (polar P0 A5 (+ (/ D 2) RA)))
 (SETQ PA8 (polar P0 A6 (+ (/ D 2) RA)))
 (SETQ PA9 (polar P0 A7 (+ (/ D 2) RA)))

 (SETQ LD1 (- L1 L3))			;longueur droite
 (SETQ RE (REM LD1 (/ 24 H)))
 (SETQ AFLEX (/ (- LD1 RE) (/ 24 H)))	;nombre de traits sur la partie droite

 (IF (/= AFLEX 0)
   (SETQ LONG (+ (/ 24 H) (/ RE AFLEX))) ;espacement des traits
   (SETQ LONG (/ 24 H))
 )

 (SETQ AC2 (* 2 (ATAN (/ L3 RA))))	;angle à décrire
 (SETQ RANG (REM AC2 (ATAN (/ (/ 24 H) RA))))
 (SETQ AANG (/ (- AC2 RANG) (ATAN (/ (/ 24 H) RA))))
				;nombre de traits dans le coude
 (SETQ ANGF (+ (ATAN (/ (/ 24 H) RA)) (/ RANG AANG)))
				;angle entre chaque trait

 (SETQ TESTEUR1 0)


 (WHILE (< TESTEUR1 AFLEX)
   (TRAFLEX1)
 )



 (COMMAND "_LINE"	 P4	P12    ""     "_LINE"	    P5
   P10	  ""	 "_ARC"	PA1    PA2    PA3    "_ARC" PA7
   PA8	  PA9
  )

 (SETQ CO (GETVAR "CECOLOR"))
 (SETVAR "CECOLOR" "8")
 (COMMAND "_LINE" P10 P12 "")
 (SETVAR "CECOLOR" CO)

 (SETQ TESTEUR2 0)
 (SETQ P1 (polar P8 0 0))

 (WHILE (< TESTEUR2 (- AANG 1))
   (TRAFLEX2)
 )


				;(SETQ P1(polar P9 0 0)) pour mise en boucle
				;(SETQ P2(polar P3 0 0)) pour mise en boucle
 (SETQ TESTEUR1 0)
 (SETQ TESTEUR2 0)
				;(TEST) pour mise en boucle
)


(DEFUN TRAFLEX1	()

 (SETQ AF1 (+ A1 (/ pi 2)))

 (SETQ PF1 (polar P1 A1 LONG))
 (SETQ PF2 (polar P1 AF1 (/ D 2)))
 (SETQ PF3 (polar P1 (+ pi AF1) (/ D 2)))


 (SETQ CO (GETVAR "CECOLOR"))
 (SETVAR "CECOLOR" "8")
 (COMMAND "_LINE" PF2 PF3 "")
 (SETVAR "CECOLOR" CO)

 (SETQ P1 (polar PF1 0 0))
 (SETQ TESTEUR1 (1+ TESTEUR1))
)

(DEFUN TRAFLEX2	()



 (SETQ A6 (ANGLE P0 P1))
 (SETQ PF1 (polar P0 A6 RA))
 (SETQ PFA1 (polar P1 A1 (* RA (/ (sin angf) (cos angf)))))
 (SETQ A6B (ANGLE P0 PFA1))
 (SETQ PF2 (polar P0 A6B RA))
 (SETQ PF8 (polar PF2 A6B (/ D 2)))
 (SETQ PF9 (polar PF2 (+ pi A6B) (/ D 2)))

 (SETQ CO (GETVAR "CECOLOR"))
 (SETVAR "CECOLOR" "8")
 (COMMAND "_LINE" PF8 PF9 "")
 (SETVAR "CECOLOR" CO)

 (SETQ A1 (ANGLE P1 PF2))
 (SETQ P1 (polar PF2 0 0))

 (SETQ TESTEUR2 (1+ TESTEUR2))

) 

[zebulon_]

Bonjour,

 

j'ai fait quelque chose de similaire, mais mon lisp commence par dessiner une polyligne (on suppose qu'il n'y a que des segments droits). Ensuite, j'exploite les points de cette polyligne pour faire les congés de raccordement de 2 segments consécutifs, afin d'obtenir une nouvelle polyligne qui a l'apparence d'une nouille. Cette polyligne, je la décale à droite et à gauche d'une distance D/2 et je fais des petites lignes perpendiculaire tous les D.

 

(defun list->variantArray (ptsList / arraySpace sArray)
 ; allocate space for an array of 2d points stored as doubles
 (setq arraySpace
   (vlax-make-safearray
     vlax-vbdouble ; element type
     (cons 0
       (- (length ptsList) 1)
     ) ; array dimension
   )
 )
 (setq sArray (vlax-safearray-fill arraySpace ptsList))
 ; return array variant
 (vlax-make-variant sArray)
)


;;; Clockwise-p
;;; Retourne T si les points p1 p2 et p3 tournent dans le sens horaire

(defun clockwise-p (p1 p2 p3)
(< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)


(defun TAN (ALPHA)
 (/ (sin ALPHA) (cos ALPHA))
)

;; ASIN et ACOS Retournent l'arc sinus ou l'arc cosinus du nombre, en radians

(defun ASIN (num)
 (if (<= -1 num 1)
   (atan num (sqrt (- 1 (expt num 2))))
   (princ
     "\nErreur: L'argument pour ASIN doit être compris entre -1 et 1"
   )
 )
)

(defun ACOS (num)
 (if (<= -1 num 1)
   (atan (sqrt (- 1 (expt num 2))) num)
   (princ
     "\nErreur: L'argument pour ACOS doit être compris entre -1 et 1"
   )
 )
)

;;; angle par trois points

(defun angle_3pts (som p1 p2 / d1 d2 d3)
 (setq d1 (distance som p1)
       d2 (distance som p2)
       d3 (distance p1 p2)
 )
 (if (and (< 0 d1) (< 0 d2))
   (acos 
     (/ 
       (+ 
         (* d1 d1) 
         (* d2 d2) 
         (- (* d3 d3))
       )
       (* 2 d1 d2)
     )
   )
 )
)




;;;
;;; 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 getPolySegs (ent / entl p1 pt bulge seg ptlst)
 (cond (ent
        (setq entl (entget ent))
        ;; save start point if polyline is closed
        (if (= (logand (cdr (assoc 70 entl)) 1) 1)
          (setq p1 (cdr (assoc 10 entl)))
        )
        ;; run thru entity list to collect list of segments
        (while (setq entl (member (assoc 10 entl) entl))
          ;; if segment then add to list
          (if (and pt bulge)
            (setq seg (list pt bulge))
          )
          ;; save next point and bulge
          (setq pt    (cdr (assoc 10 entl))
                bulge (cdr (assoc 42 entl))
          )
          ;; if segment is build then add last point to segment
          ;; and add segment to list
          (if seg
            (setq seg (append seg (list pt))
                  ptlst (cons seg ptlst))
          )
          ;; reduce list and clear temporary segment
          (setq entl  (cdr entl)
                seg   nil
          )
        )
       )
 )
 ;; if polyline is closed then add closing segment to list
 (if p1 (setq ptlst (cons (list pt bulge p1) ptlst)))
 ;; reverse and return list of segments
 (reverse ptlst)
)



(defun do_flex1_main ()

 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc) 
             )
 )


 ;; récupérer les sommets de la polyligne
 (setq CHEMIN (getpolysegs e))
 (setq NCHEMIN nil)
 (setq I 0)
 (repeat (- (length CHEMIN) 1)
   (setq seg1 (nth I CHEMIN))
   (setq seg2 (nth (+ I 1) CHEMIN))
   (mapcar 'set '(P1 bulge1 P2) seg1)
   (mapcar 'set '(P2 bulge2 P3) seg2)
   ;; congé de raccordement
   (SETQ L1 (DISTANCE P1 P2))
   (SETQ L2 (DISTANCE P2 P3))
   (SETQ L3 (MIN (/ L1 2) (/ L2 2)))
   (SETQ P8 (polar P2 (angle P2 P1) L3))
   (SETQ P9 (polar P2 (angle P2 P3) L3))
   (setq P10 (polar P8 (+ (angle P2 P1) (/ pi 2)) 1.00))
   (setq P11 (polar P9 (+ (angle P2 P3) (/ pi 2)) 1.00))
   (setq P0 (inters P8 P10 P9 P11 nil))
   ;; calculer le bulge
   (if (clockwise-p P1 P2 P3)
     (setq ALPHA 1)
     (setq ALPHA -1)
   )
   (setq bulge (* ALPHA (tan (* (angle_3pts P0 P8 P9) -0.25))))  ;; le bulge c'est la tangente du quart de l'angle inscrit
   (cond
     ((= I 0)
       (setq NCHEMIN (cons (list P1 0 P8) NCHEMIN))
     )
     ((> (distance OldP9 P8) 0.0001)
       (setq NCHEMIN (cons (list OldP9 0 P8) NCHEMIN))
     )
   )
   (setq OldP9 P9) 
   (setq NCHEMIN (cons (list P8 bulge P9) NCHEMIN))

   (setq I (+ I 1))
 )
 (setq NCHEMIN (cons (list P9 0 P3) NCHEMIN))
 (setq NCHEMIN (reverse NCHEMIN))
 ;; tracer la nouvelle polyligne avec la liste NCHEMIN
 (setq I 0)
 (setq LPTS (caar NCHEMIN))
 (setq LBULGES nil)
 (repeat (length NCHEMIN)
   (setq seg (nth I NCHEMIN))
   (mapcar 'set '(P1 bulge P2) seg)
   (setq LPTS (append LPTS P2))
   (setq LBULGES (append LBULGES (list bulge)))
   (setq I (+ I 1))
 )
 (setq pl (vla-addlightWeightPolyline space (list->variantArray LPTS)))
 ;; mettre à jour les arcs
 (setq I 0)
 (repeat (length LBULGES)
   (vla-setbulge pl I (nth I LBULGES))
   (setq I (+ I 1))
 )
 ;; décaler la nouvelle polyligne à droite et à gauche
 (setq D (getreal "\nLargeur du chemin : "))
 (vla-offset pl (/ D 2.0))    ; à droite
 (setq OFFSETD (vlax-ename->vla-object (entlast)))
 (vla-offset pl (/ D -2.0))    ; à gauche
 (setq OFFSETG (vlax-ename->vla-object (entlast)))
 ;; effacer la polyligne d'origine
 (vla-erase (vlax-ename->vla-object e))
 ;; rajouter les un trait perpendiculaire tous les D
 (setq PK 0)
 (while (< PK (vlax-curve-getDistAtPoint pl (vlax-curve-getEndPoint pl))) 
   (setq P0 (vlax-curve-getPointAtDist pl PK))
   (setq P1 (vlax-curve-getClosestPointTo OFFSETD P0))
   (setq P2 (vlax-curve-getClosestPointTo OFFSETG P0))
   (vla-addLine
     Space
      (vlax-3d-point P1)
      (vlax-3d-point P2)
   )

   (setq PK (+ PK D))
 )
 ;; tracer le dernier segment aussi
 (vla-addLine
   Space
     (vlax-3d-point (vlax-curve-getEndPoint OFFSETD))
     (vlax-3d-point (vlax-curve-getEndPoint OFFSETG))
 )
 ;; supprimer la polyligne d'axe
 (vla-erase pl)
)


(defun c:flex1 ()
 (vl-load-com)
 (setq LELEM (mycmd '("_.pline")))
 (if LELEM
   (progn
     (setq e (car LELEM))
     (do_flex1_main)
   )
 )
 (princ)
) 

 

Espérant que ça peut aider...

 

Amicalement

Vincent

 

[(gile)]

Salut,

 

Pascal19,

Ce que tu demandes n'est pas simple, on peut utiliser la fonction grread dans une boucle pour récupérer dynamiquement la position du curseur et modifier ou créer dynamiquement des objets en conséquence, mais l'inconvénient est que quand grread est actif les accrochages et repérages aux objets sont désactivés.

 

Tu peux aussi essayer MPline ou Mspline ici.

[pascal19]

Merci pour vos réponses, je vais regarder cette commande grread mais elle a l'air

un peu compliqué (pour moi)

Je vais aussi tester le programme à zebulon, pour comparer...

a+