[Résolu] Juste une petite polyligne...

DenisHen · le 24 mai 2022

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

DenisHen · le 24 mai 2022

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

DenisHen · le 24 mai 2022

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

Luna · le 24 mai 2022

Coucou,

Essaye avec ceci :

(command-s "_-HATCH" "_Transparency" "80" "_DRaw" "_Back" "_Properties" "_Solid" "_Select" (entlast) "" "")

Bisous,
Luna

DenisHen · le 26 mai 2022

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.

Connexion

[Résolu] Juste une petite polyligne...

Messages recommandés

DenisHen

DenisHen

DenisHen

Luna

DenisHen

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante