Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Juste une petite polyligne...

DenisHen

Par DenisHen,
dans Débuter en LISP

 Partager

Messages recommandés

DenisHen Collaborator

DenisHen

Posté(e)
Posté(e)

Bonsoir à toute la communauté.

Voilà, je pensais le truc facile, mais pas du tout, ça fait une heure que je tourne en rond, j'essais de dessiner ce qui est en rouge, pour l'instant, je ne m'occupe de la hachure, mais juste de la polyligne.
J'ai écris ça, avec des (princ pour regarder les "calculs" :
  

(defun c:SymbOuverture ()
  (if
    (and
      (setq ptHG (getpoint "\nPoint en haut à gauche : "))
      (setq ptHD (getpoint ptHG "\nPoint en haut à droite : "))
      (setq ptBG (getpoint ptHG "\nPoint en bas à gauche : "))
    )
     (progn
       (setq old_Osmode (getvar 'osmode))
       (setvar 'osmode 0)
       (setq DistH (distance ptHG ptHD))
       (setq DistV (distance ptHG ptBG))
       (princ "\nDistH = ")
       (princ DistH)
       (princ "\nDisV = ")
       (princ DistV)
       (setq EnrobH (/ DistH 10))
       (setq EnrobV (/ DistV 10))
       (princ "\nEnrobH = ")
       (princ EnrobH)
       (princ "\nEnrobV = ")
       (princ EnrobV)

       (setq PtEnrobHG (list (+ (car ptHG) EnrobH)
			     (- (car (cdr ptHG)) EnrobV)
		       )
       )
       (princ "\nPtEnrobHG = ")
       (princ PtEnrobHG)
       (setq PtEnrobHD (list (- (car ptHD) EnrobH)
			     (- (car (cdr ptHD)) EnrobV)
		       )
       )
       (princ "\nPtEnrobHD = ")
       (princ PtEnrobHD)
       (setq PtEnrobBG (list (+ (car ptBG) EnrobH)
			     (+ (car (cdr ptBG)) EnrobV)
		       )
       )
       (princ "\nPtEnrobBG = ")
       (princ PtEnrobBG)
       ;;(setq PtEnobMid (/ DistV 10))

              (setq PtEnobMid (list (+ (car ptHG) EnrobH EnrobH)
			     (- (car (cdr ptHG)) EnrobV EnrobV)
		       )
       )
       (princ "\nPtEnrobHG = ")
       (princ PtEnrobHG)

       )
     (command "_pline" PtEnrobBG PtEnrobHG PtEnrobHD PtEnobMid "_clore")
     (setvar 'osmode old_Osmode)
  )
  (princ)
)

Loes points saiss sont les point du cadre vert, HG=Haut Gauche...
Mais je ne sais absolument pas pourquoi : aucune erreur, aucune polyligne.
Je pensais avoir fais des progrès avec les listes, en tous cas, je tente.
Qu'ai-je mal fais ?
Une idée ?

SymbOuverture.gif.e3306951459ec22de710698ed740c78f.gif

Windows 10 Pro 64bits / AutoCAD 3D 2022

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).

Lien vers le commentaire
Partager sur d’autres sites
DenisHen Collaborator

DenisHen

Posté(e)
  • Auteur
Posté(e)

A force de chercher, je viens de trouver, c'était le (command en dehors du (progn...
Grrrrrrr ! ! ! ! ! 
Je me giflerais parfois...

Windows 10 Pro 64bits / AutoCAD 3D 2022

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).

Lien vers le commentaire
Partager sur d’autres sites
DenisHen Collaborator

DenisHen

Posté(e)
  • Auteur
Posté(e)

Par contre, pour hachurer cette polyligne, j'ai du mal...
Voici mon bout de code : 

(command-s "-hachures" "TRAN" "80" "T" "E" "P" "S" (entlast) "")

 

Windows 10 Pro 64bits / AutoCAD 3D 2022

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).

Lien vers le commentaire
Partager sur d’autres sites
DenisHen Collaborator

DenisHen

Posté(e)
  • Auteur
Posté(e)

Chalut Luna.
Merci pour ton aide, j'avais fini par réussir à le faire.
Voici donc mon code, si ça intéresse quelqu'un, dans le futur.
  

(defun c:SymbOuverture ()
  (princ "\n\tDéveloppé par Denis H. (1.0)")
  (if (and (setq ptHG (getpoint "\nPoint en haut à gauche : "))
           (setq ptHD (getpoint ptHG "\nPoint en haut à droite : "))
           (setq ptBG (getpoint ptHG "\nPoint en bas à gauche : "))
      ) ;_ Fin de and
    (progn (setq old_Osmode (getvar 'osmode))
           (setvar 'osmode 0)
           (setq DistH (distance ptHG ptHD))
           (setq DistV (distance ptHG ptBG))
           (setq EnrobH (/ DistH 10))
           (setq EnrobV (/ DistV 10))
           (if (< EnrobV EnrobH)
             (setq EnrobH EnrobV)
             (setq EnrobV EnrobH)
           ) ;_ Fin de if
           (setq PtEnrobHG (list (+ (car ptHG) EnrobH) (- (car (cdr ptHG)) EnrobV)))
           (setq PtEnrobHD (list (- (car ptHD) EnrobH) (- (car (cdr ptHD)) EnrobV)))
           (setq PtEnrobBG (list (+ (car ptBG) EnrobH) (+ (car (cdr ptBG)) EnrobV)))
           (setq PtEnobMid (list (+ (car ptHG) EnrobH EnrobH) (- (car (cdr ptHG)) EnrobV EnrobV)))
           (command-s "_pline" PtEnrobBG PtEnrobHG PtEnrobHD PtEnobMid PtEnrobBG "")
           (command-s "-hachures" "P" "S" "TRAN" "85" "T" "E" "s" (entlast) "" "")
           ;; Ecrire ici le code pour les coffrets volets roulants ******************************************
           (setq ExistCVR (vlax-ldata-get "DenisH" "SymbOuv_ExistCVR"))
           (if (/= ExistCVR "Oui")
             (vlax-ldata-put "DenisH" "SymbOuv_ExistCVR" "Non")
             (setq ExistCVR "Non")
           ) ;_ Fin de if
           (setq DistCVR (vlax-ldata-get "DenisH" "SymbOuv_DistCVR"))
           (if (= DistCVR nil)
             (vlax-ldata-put "DenisH" "SymbOuv_DistCVR" 1.5)
           ) ;_ Fin de if
           (setq HautCVR (vlax-ldata-get "DenisH" "SymbOuv_HautCVR"))
           (if (= HautCVR nil)
             (vlax-ldata-put "DenisH" "SymbOuv_HautCVR" 32)
           ) ;_ Fin de if
           (setq DebCVR (vlax-ldata-get "DenisH" "SymbOuv_DebCVR"))
           (if (= DebCVR nil)
             (vlax-ldata-put "DenisH" "SymbOuv_DebCVR" 0)
             (setq DebCVR 0)
           ) ;_ Fin de if
      (setq Rep (Msgbox "SymbOuverture :" "Placer un coffret volet roulant ?" (+ 4 32)))
      (cond ((= Rep 6)
             (vlax-ldata-put "DenisH" "SymbOuv_ExistCVR" "Oui")
             )
            ((= Rep 7)
             (vlax-ldata-put "DenisH" "SymbOuv_ExistCVR" "Non")
             ))
      (setq CVR (vlax-ldata-get "DenisH" "SymbOuv_ExistCVR"))
           (if (/= CVR "Non")
             (progn (vlax-ldata-put "DenisH" "SymbOuv_ExistCVR" "Oui")
                    (initget 4)
                    (setq DistCVR (getdist (strcat "\nDistance entre ouverture et coffret volet roulant <"
                                                   (rtos (vlax-ldata-get "DenisH" "SymbOuv_DistCVR") 2 1)
                                                   "> : "
                                           ) ;_ Fin de strcat
                                  ) ;_ Fin de getdist
                    ) ;_ Fin de setq
                    (if (= DistCVR nil)
                      (setq DistCVR (vlax-ldata-get "DenisH" "SymbOuv_DistCVR"))
                    ) ;_ Fin de if
                    (vlax-ldata-put "DenisH" "SymbOuv_DistCVR" DistCVR)
                    (princ "\nDistCVR=")
                    (princ DistCVR)
                    (initget 4)
                    (setq HautCVR (getdist (strcat "\nHauteur coffret volet roulant <"
                                                   (rtos (vlax-ldata-get "DenisH" "SymbOuv_HautCVR") 2 1)
                                                   "> : "
                                           ) ;_ Fin de strcat
                                  ) ;_ Fin de getdist
                    ) ;_ Fin de setq
                    (if (= HautCVR nil)
                      (setq HautCVR (vlax-ldata-get "DenisH" "SymbOuv_HautCVR"))
                    ) ;_ Fin de if
                    (vlax-ldata-put "DenisH" "SymbOuv_HautCVR" HautCVR)
                    (initget 4)
                    (setq DebCVR (getdist (strcat "\nDisqtance des débords du coffret volet roulant <"
                                                   (rtos (vlax-ldata-get "DenisH" "SymbOuv_DebCVR") 2 1)
                                                   "> : "
                                           ) ;_ Fin de strcat
                                  ) ;_ Fin de getdist
                    ) ;_ Fin de setq
                    (if (= DebCVR nil)
                      (setq DebCVR (vlax-ldata-get "DenisH" "SymbOuv_DebCVR"))
                      (vlax-ldata-put "DenisH" "SymbOuv_DebCVR" DebCVR)
                    ) ;_ Fin de if
                    (vlax-ldata-put "DenisH" "SymbOuv_DebCVR" DebCVR)
                    (setq PtCVRBG (list (- (car ptHG) DebCVR) (+ (car (cdr ptHG)) DistCVR)))
                    (setq PtCVRHG (list (- (car ptHG) DebCVR) (+ (car (cdr ptHG)) DistCVR HautCVR)))
                    (setq PtCVRBD (list (+ (car ptHD) DebCVR) (+ (car (cdr ptHD)) DistCVR)))
                    (setq PtCVRHD (list (+ (car ptHD) DebCVR) (+ (car (cdr ptHD)) DistCVR HautCVR)))
                    (command-s "_pline" PtCVRBG PtCVRHG PtCVRHD PtCVRBD PtCVRBG "")
                    (setq PtInsTxt (list (+ (car PtCVRBG) (/ (distance PtCVRBG PtCVRBD) 2)) (+ (car (cdr PtCVRBG)) (/ (distance PtCVRBG PtCVRHG) 2))))
                    (command "-style" "CofVolRoul" "ARIAL" "A" "Oui" "Non" 2.5 1 0 "Non" "Non")
                    (command "_text" "J" "MC" PtInsTxt 0 "CVR")
             ) ;_ Fin de progn
             (vlax-ldata-put "DenisH" "SymbOuv_ExistCVR" "Non")
           ) ;_ Fin de progn
    ) ;_ Fin de if
  ) ;_ Fin de if
  (setvar 'osmode old_Osmode)
  (princ)
) ;_ Fin de defun
;;;*********************************************
;;;                MsgBox sans VBA              
;;;          de (gile), il me semble,           
;;;       mais je n'en suis pas certain,        
;;;   car ça ressemble à du Patrick ou Tramber  
;;;*********************************************
(defun msgbox (titre message bouton / wsh) ; Types de bouton
  ; Valeur 	Description
  ; 0 		Affiche le bouton OK.
  ; 1 		Affiche les boutons OK et Cancel.
  ; 2 		Affiche les boutons Abort, Retry et Ignore.
  ; 3 		Affiche les boutons Yes, No et Cancel.
  ; 4 		Affiche les boutons Yes et No.
  ; 5 		Affiche les boutons Retry et Cancel.
  ; Types d'icônes
  ; Valeur 	Description
  ; 16 		Affiche l'icône "Stop".
  ; 32 		Affiche l'icône "Point d'interrogation".
  ; 48 		Affiche l'icône "Point d'exclamation".
  ; 64 		Affiche l'icône "Informations".
  ; Valeurs de retour
  ; Valeur 	Description
  ; 1 		Bouton OK
  ; 2 		Bouton Cancel
  ; 3 		Bouton Abort
  ; 4 		Bouton Retry
  ; 5 		Bouton Ignore
  ; 6 		Bouton Yes
  ; 7 		Bouton No
  ;
  ; Exemple : (msgbox "Mon alerte" "Autocad coule..." (+ 2 16))
  (setq wsh (vlax-create-Object "WScript.Shell")
        res (vlax-invoke wsh 'popup message nil titre bouton)
  ) ;_ Fin de setq
  (vlax-release-Object wsh)
  res
) ;_ Fin de defun
;|«Visual LISP© Format Options»
(199 2 2 2 T "Fin de " 100 9 0 0 nil nil nil nil T)
;*** NE PAS AJOUTER de texte au-dessous du commentaire! ***|;

Pour bien faire, il aurait fallu que je remette les paramètres de nom de hachure et de transparence tels qu'ils étaient avant, mais je n'ai pas trop le temps.
Encore merci à vous.
Denis.

Windows 10 Pro 64bits / AutoCAD 3D 2022

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres (developpez.net).
Davantage d'avantages, avantagent davantage (Bobby Lapointe).
La connaissance s'accroît quand on la partage (Socrate).

Lien vers le commentaire
Partager sur d’autres sites

Rejoindre la conversation

Vous pouvez publier maintenant et vous inscrire plus tard. Si vous avez un compte, connectez-vous maintenant pour publier avec votre compte.

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

Chargement
×
 Partager
Aller sur la liste des sujets
×
×
  • 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é

  J’accepte