Lisp trace deux droite

[Max73]

Bonjour, 

Je début en lisp et j ai un peut de mal....

je cherche a crée une lisp qui me permet de tracer des droites de construction afin de report une vue en plan sur une coupe a l'aide d une droit a 45 °.

Ci-joint un exemple, il faudrait que je puisse tracé une droit et qu il me crée automatiquement l autre droite de construction en fonction de la vue que je veux.

exemple de droite.dwg

[didier]

Bonjour @Max73

Je ne vois pas trop ce qu'il faut faire, c'est sûrement simple à coder, mais il faut comprendre l'attente.

J'ai regardé le fichier et je ne sais pas s'il faut dessiner la droite 45° sur les intersections des droites XRAY ou l'inverse.

Le mieux quand on pose ce genre de question est de mettre les étapes dans le dessin.

Amicalement

[Max73]

Bonjour Didier

oui désolé 

En faite les droites a 45 je les traces une fois au début, et ensuite il me faut tracer les autres droite au coup pour coup, lorsque je crée les vues ou que j ai des modifications sur celle ci, ou des modifications sur les coupes que je reporte sur la vue en plan. 

[didier]

Bonjour.

Je dois revenir à la charge pour demande d'explications, (ce sera mon dernier essai).

OK pour le rectangle "Vue de dessus" 'c'est de celui-ci que partent quatre droites depuis les sommets

Ensuite, il va falloir dessiner des lignes à 45 °...

Comment faut-il les dessiner ? À quelle distance de la vue de dessus ? Quels sont les points de départ de ces lignes et quelle est leur longueur ?

Sachant que le milieu de ces lignes est sur une intersection des droites, je me demande comment elles sont dessinées.

Merci des explications pour pouvoir fournir de l'aide...

Amicalement

 

 

 

[Max73]

Bonjour,

Pas de soucis pour plus d explication 

les lignes à 45° je les traces en fonction de la vu de dessus elle non pas vraiment position précise comme pour les coupes.

Je les place pour que mon plan soient claire au finale.

Après c'est droite a 45° ce devrait pas faire parti forcement du lisp, ce qui m intéresse surtout c est que lorsque je trace une droite il y est une autre droite qui ce trace sur l intersection d une des droites a 45 ° en fonction de la vue sur laquelle je travail.

merci

Amicalement

(Désolé pour les fautes d orthographe)

[didier]

Bonjour.

Je ne comprends pas ce qu'il y a à faire, désolé
Je laisse quelqu'un d'autre répondre, des fois qu'il soit plus éclairé que moi.

Amicalement

[Luna]

Coucou,

La programmation c'est pas de la magie...il faut forcément une suite logique d'évènements pour pouvoir faire fonctionner un programme !
Donc si tu places tes droites à 45° n'importe où, comment doit-on les sélectionner ? Possèdent-elles un calque strictement réservé pour ces lignes ? Est-ce uniquement des lignes, ou bien cela peut aussi être des polylignes ? des droites ?
Ensuite, comment le programme doit-il être en mesure de comprendre sur quelle "vue sur laquelle tu travailles" ? Peut-être qu'un logigramme permettrait d'y voir un peu plus clair sur la demande..
Les droites qui seront tracés doivent-elles appartenir à un calque précis ? Sont-elles temporaires ou bien sont-elle constantes (c'est-à-dire, faut-il prévoir de les supprimer à un moment donné ou pas ? Si oui, à quel moment ?) ?
Le programme souhaité ne doit donc servir qu'à tracer les droites horizontales et verticales en cliquant sur un point, rien de plus c'est bien cela ?

Bisous,
Luna

[didier]

Coucou

je plussoie Luna que je remercie de me venir en aide

Ce qu'il faut a minima, c'est comment c'est fait actuellement "à la main".

En ayant ce mode opératoire, on pourra décider de ce qui peut être automatisé et comment.

Ah la génération OK GOOGLE !!... je veux un lisp ...

Amicalement

 

[PHILPHIL]

Hello  Max

 

voici un lisp qui devrait t'aider, je  l'utilise pour faire du rapport de traits entre  coupes et façades quand je bosse en 2D.

au risque de passer pour un "vieux CON" et comme je l'ai appris ( en dessinant sur une planche a dessin a la mano ) et appliqué depuis sur autocad bien vite.

je bosse avec la méthode européenne sous autocad en 2D

les different niveaux l'un au dessus de l'autre a distance fixe exact ( 5000 unites par exemple )

facades, coupes  vue de droite projetées a gauche et inversement

la fonction autocad " UCSFOLLOW" permettant de s'y retrouvé ( la fonction a du etre inventé pour ca non ? je ne connais pas l historique des fonctions autocad )

je dirais que la méthode de dessin me fait hurler quand je vois ca.

( le calque zero ne doit jamais etre utilisé, car il est commun a tous les fichiers encore plus quand ceux ci sont en XREF )

quand je reçois encore des fichiers ou toutes les façades sont alignées comme ça n'importe ou dans l'espace papier a des kilomètres du 0,0,0

ça ne permet pas de vérifier l'exactitude des fichiers. en balançant sur le plan des "_XLINE"  voir si les fenêtres des façades sont bien alignées aux fenêtre en plan.

on m'a dit une fois , "il est pas interdit de vérifier le boulot des autres"

https://fr.wikipedia.org/wiki/Dessin_technique

( faire une charrette sans méthode on finit le dimanche soir, une charrette avec méthode on finit le vendredi avec l'apéro )

ca reflète ou réfracte des LIGNES ( pas des polylignes ) par rapport a une ligne

si tu as déja des polylignes, tu refais  des lignes dans le prolongement ( meme calque  )

a+

Phil (Vc)( déja ?)

 

(defun c:reflet ()
  (setvar "cmdecho" 0)
  (setq typeactionreflet (getcfg "APPDATA/typeactionreflet"))
  (prompt "\n 1 : SELECTIONNER LES LIGNES A REFLETER  >|< :")
  (prompt "\n 2 : SELECTIONNER LES LIGNES A REFRACTER /|\\ :")
  (prompt "\n 3 : SELECTIONNER LES LIGNES A REFLETER ( EN FAISANT UNE COPIE ) >>|<< :")
  (prompt "\n 4 : SELECTIONNER LES LIGNES A REFRACTER ( EN FAISANT UNE COPIE ) //|\\\\ :")
  (prompt "\n 5 : SELECTIONNER LES LIGNES A REFLETER et PROLONGER ( EN FAISANT UNE COPIE ) :")
  (prompt "\n 6 : SELECTIONNER LES LIGNES A REFRACTER et PROLONGER ( EN FAISANT UNE COPIE ) :")
;;;  (prompt "\n 7 : SELECTIONNER LES LIGNES A REFRACTER et PROLONGER et A JOINDRE( EN FAISANT UNE COPIE ) :")
  (initget "1 2 3 4 5 6")
  (setq tmp (getkword
              (strcat "\nSELECTIONNER LE TYPE D'ACTION DESIRE ( 1 2 3 4 5 6 ) <" typeactionreflet "> : ")
            )
  )
  (if tmp
    (setq typeactionreflet tmp)
  )
  (setcfg "APPDATA/typeactionreflet" typeactionreflet)
  (if (= typeactionreflet "1")
    (progn
;;;---------------------------------------------------------
;;;CRER UNE LIGNE REFLET D'UNE LIGNE PAR RAPPORT A UNE AUTRE
;;;---------------------------------------------------------
           ;;(setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
           (setvar "cmdecho" 0)
           (setq cav (getvar "clayer"))
           (setq osm (getvar "osmode"))
           (setq cecol (getvar "cecolor"))
           (setq cety (getvar "celtype"))
           (setq celtsca (getvar "celtscale"))
           (setvar "osmode" 0)
           (prompt "SELECTIONNER LES LIGNES A REFLETER :")
           (setq listeligne nil)
           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "")
           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
           (setq p3 (cdr (assoc 10 (entget ss2))))
           (setq p4 (cdr (assoc 11 (entget ss2))))
           (setq ucsfo (getvar "ucsfollow"))
           (setvar "ucsfollow" 0)
           (command-s "scu" "")
           (setq compt 0)
           (setq com (sslength listeligne))
           (while (< compt com)
             (progn (setq ss1 (ssname listeligne compt))
                    (setq p1 (cdr (assoc 10 (entget ss1))))
                    (setq p2 (cdr (assoc 11 (entget ss1))))
                    (setq calq1 (cdr (assoc 8 (entget ss1))))
                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
                    (setq echl1 (cdr (assoc 48 (entget ss1))))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ang1 (angle ptinter p1))
                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
                    (setq angop (+ (- pi ang2) ang1))
                    (setq angok (- ang2 angop))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ptalong1 (polar ptinter angok 10000
                                                                                     ;;(/ 1000 techl)
                                                                                     ))
                    (setq ent (entget ss1))
                    (if (< (distance ptinter p1) (distance ptinter p2))
                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
                    )
                    (entmod ent)
                    (if (/= couleur1 nil)
                      (setvar "cecolor" (rtos couleur1 2 0))
                      (setvar "cecolor" "ducalque")
                    )
                    (if (/= typelig1 nil)
                      (setvar "celtype" typelig1)
                      (setvar "celtype" "ducalque")
                    )
                    (if (/= echl1 nil)
                      (setvar "celtscale" echl1)
                    )
                    (if (/= calq1 nil)
                      (setvar "clayer" calq1)
                    )
                    (command-s "ligne" ptinter ptalong1 "")
                    (setq couleur1 nil)
                    (setq typelig1 nil)
                    (setq echl1 nil)
                    (setq calq1 nil)
             )
             (command-s "effacer" ss1 "")
             (setq compt (1+ compt))
           )
           (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "")
           (setvar "clayer" cav)
           (setvar "cecolor" cecol)
           (setvar "celtype" cety)
           (setvar "celtscale" celtsca)
           (setvar "osmode" osm)
           (command-s "scu" "P")
           (setvar "ucsfollow" ucsfo)
    )
  )
  (if (= typeactionreflet "2")
    (progn
;;;-----------------------------------------------------------
;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE
;;;-----------------------------------------------------------
          ;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
           (setvar "cmdecho" 0)
           (setq cav (getvar "clayer"))
           (setq osm (getvar "osmode"))
           (setq cecol (getvar "cecolor"))
           (setq cety (getvar "celtype"))
           (setq celtsca (getvar "celtscale"))
           (setq osm (getvar "osmode"))
           (setvar "osmode" 0)
           (prompt "SELECTIONNER LES LIGNES A REFRACTER :")
           (setq listeligne nil)
           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "")
           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
           (setq p3 (cdr (assoc 10 (entget ss2))))
           (setq p4 (cdr (assoc 11 (entget ss2))))
           (setq ucsfo (getvar "ucsfollow"))
           (setvar "ucsfollow" 0)
           (command-s "scu" "")
           (setq compt 0)
           (setq com (sslength listeligne))
           (while (< compt com)
             (progn (setq ss1 (ssname listeligne compt))
                    (setq p1 (cdr (assoc 10 (entget ss1))))
                    (setq p2 (cdr (assoc 11 (entget ss1))))
                    (setq calq1 (cdr (assoc 8 (entget ss1))))
                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
                    (setq echl1 (cdr (assoc 48 (entget ss1))))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ang1 (angle p1 ptinter))
                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
                    (setq angop (+ (- pi ang2) ang1))
                    (setq angok (- ang2 angop))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ptalong1 (polar ptinter angok 10000
                          ;;(/ 1000 techl)
                          ))
                    (setq ent (entget ss1))
                    (if (< (distance ptinter p1) (distance ptinter p2))
                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
                    )
                    (entmod ent)
                    (if (/= couleur1 nil)
                      (setvar "cecolor" (rtos couleur1 2 0))
                      (setvar "cecolor" "ducalque")
                    )
                    (if (/= typelig1 nil)
                      (setvar "celtype" typelig1)
                      (setvar "celtype" "ducalque")
                    )
                    (if (/= echl1 nil)
                      (setvar "celtscale" echl1)
                    )
                    (if (/= calq1 nil)
                      (setvar "clayer" calq1)
                    )
                    (command-s "ligne" ptinter ptalong1 "")
                    (setq couleur1 nil)
                    (setq typelig1 nil)
                    (setq echl1 nil)
                    (setq calq1 nil)
             )
             (command-s "effacer" ss1 "")
             (setq compt (1+ compt))
           )
           (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "")
           (setvar "clayer" cav)
           (setvar "cecolor" cecol)
           (setvar "celtype" cety)
           (setvar "celtscale" celtsca)
           (setvar "osmode" osm)
           (command-s "scu" "P")
           (setvar "ucsfollow" ucsfo)
    )
  )
  (if (= typeactionreflet "3")
    (progn
;;;------------------------------------------------------------------------------
;;;CRER UNE LIGNE REFLET D'UNE LIGNE PAR RAPPORT A UNE AUTRE EN FAISANT UNE COPIE
;;;------------------------------------------------------------------------------
        ;;   (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
           (setvar "cmdecho" 0)
           (setq cav (getvar "clayer"))
           (setq osm (getvar "osmode"))
           (setq cecol (getvar "cecolor"))
           (setq cety (getvar "celtype"))
           (setq celtsca (getvar "celtscale"))
           (setvar "osmode" 0)
           (prompt "SELECTIONNER LES LIGNES A REFLETER ( EN FAISANT UNE COPIE ) :")
           (setq listeligne nil)
           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "")
           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
           (setq p3 (cdr (assoc 10 (entget ss2))))
           (setq p4 (cdr (assoc 11 (entget ss2))))
           (setq ucsfo (getvar "ucsfollow"))
           (setvar "ucsfollow" 0)
           (command-s "scu" "")
           (setq compt 0)
           (setq com (sslength listeligne))
           (while (< compt com)
             (progn (setq ss1 (ssname listeligne compt))
                    (command-s "COPIER" ss1 "" "0,0" "0,0")
                    (setq p1 (cdr (assoc 10 (entget ss1))))
                    (setq p2 (cdr (assoc 11 (entget ss1))))
                    (setq calq1 (cdr (assoc 8 (entget ss1))))
                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
                    (setq echl1 (cdr (assoc 48 (entget ss1))))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ang1 (angle ptinter p1))
                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
                    (setq angop (+ (- pi ang2) ang1))
                    (setq angok (- ang2 angop))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ptalong1 (polar ptinter angok 10000
                          ;;(/ 1000 techl)
                          ))
                    (setq ent (entget ss1))
                    (if (< (distance ptinter p1) (distance ptinter p2))
                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
                    )
                    (entmod ent)
                    (if (/= couleur1 nil)
                      (setvar "cecolor" (rtos couleur1 2 0))
                      (setvar "cecolor" "ducalque")
                    )
                    (if (/= typelig1 nil)
                      (setvar "celtype" typelig1)
                      (setvar "celtype" "ducalque")
                    )
                    (if (/= echl1 nil)
                      (setvar "celtscale" echl1)
                    )
                    (if (/= calq1 nil)
                      (setvar "clayer" calq1)
                    )
                    (command-s "ligne" ptinter ptalong1 "")
                    (setq couleur1 nil)
                    (setq typelig1 nil)
                    (setq echl1 nil)
                    (setq calq1 nil)
             )
             (command-s "effacer" ss1 "")
             (setq compt (1+ compt))
           )
           (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "")
           (setvar "clayer" cav)
           (setvar "cecolor" cecol)
           (setvar "celtype" cety)
           (setvar "celtscale" celtsca)
           (setvar "osmode" osm)
           (command-s "scu" "P")
           (setvar "ucsfollow" ucsfo)
    )
  )
  (if (= typeactionreflet "4")
    (progn
;;;-----------------------------------------------------------
;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE
;;;-----------------------------------------------------------
         ;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
           (setvar "cmdecho" 0)
           (setq cav (getvar "clayer"))
           (setq osm (getvar "osmode"))
           (setq cecol (getvar "cecolor"))
           (setq cety (getvar "celtype"))
           (setq celtsca (getvar "celtscale"))
           (setq osm (getvar "osmode"))
           (setvar "osmode" 0)
           (prompt "SELECTIONNER LES LIGNES A REFRACTER ( EN FAISANT UNE COPIE ) :")
           (setq listeligne nil)
           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "")
           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
           (setq p3 (cdr (assoc 10 (entget ss2))))
           (setq p4 (cdr (assoc 11 (entget ss2))))
           (setq ucsfo (getvar "ucsfollow"))
           (setvar "ucsfollow" 0)
           (command-s "scu" "")
           (setq compt 0)
           (setq com (sslength listeligne))
           (while (< compt com)
             (progn (setq ss1 (ssname listeligne compt))
                    (command-s "COPIER" ss1 "" "0,0" "0,0")
                    (setq p1 (cdr (assoc 10 (entget ss1))))
                    (setq p2 (cdr (assoc 11 (entget ss1))))
                    (setq calq1 (cdr (assoc 8 (entget ss1))))
                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
                    (setq echl1 (cdr (assoc 48 (entget ss1))))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ang1 (angle p1 ptinter))
                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
                    (setq angop (+ (- pi ang2) ang1))
                    (setq angok (- ang2 angop))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ptalong1 (polar ptinter angok 10000
                          ;;(/ 1000 techl)
                          ))
                    (setq ent (entget ss1))
                    (if (< (distance ptinter p1) (distance ptinter p2))
                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
                    )
                    (entmod ent)
                    (if (/= couleur1 nil)
                      (setvar "cecolor" (rtos couleur1 2 0))
                      (setvar "cecolor" "ducalque")
                    )
                    (if (/= typelig1 nil)
                      (setvar "celtype" typelig1)
                      (setvar "celtype" "ducalque")
                    )
                    (if (/= echl1 nil)
                      (setvar "celtscale" echl1)
                    )
                    (if (/= calq1 nil)
                      (setvar "clayer" calq1)
                    )
                    (command-s "ligne" ptinter ptalong1 "")
                    (setq couleur1 nil)
                    (setq typelig1 nil)
                    (setq echl1 nil)
                    (setq calq1 nil)
             )
             (command-s "effacer" ss1 "")
             (setq compt (1+ compt))
           )
           (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "")
           (setvar "clayer" cav)
           (setvar "cecolor" cecol)
           (setvar "celtype" cety)
           (setvar "celtscale" celtsca)
           (setvar "osmode" osm)
           (command-s "scu" "P")
           (setvar "ucsfollow" ucsfo)
    )
  )
  (if (= typeactionreflet "5")
    (progn
;;;---------------------------------------------------------
;;;CRER UNE LIGNE REFLET D'UNE LIGNE PAR RAPPORT A UNE AUTRE et LA PROLONGE
;;;---------------------------------------------------------
         ;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
           (setvar "cmdecho" 0)
           (setq cav (getvar "clayer"))
           (setq osm (getvar "osmode"))
           (setq cecol (getvar "cecolor"))
           (setq cety (getvar "celtype"))
           (setq celtsca (getvar "celtscale"))
           (setvar "osmode" 0)
           (prompt "SELECTIONNER LES LIGNES A REFLETER et PROLONGER ( EN FAISANT UNE COPIE ) :")
           (setq listeligne nil)
           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "")
           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
           (setq p3 (cdr (assoc 10 (entget ss2))))
           (setq p4 (cdr (assoc 11 (entget ss2))))
           (setq ucsfo (getvar "ucsfollow"))
           (setvar "ucsfollow" 0)
           (command-s "scu" "")
           (setq compt 0)
           (setq com (sslength listeligne))
           (while (< compt com)
             (progn (setq ss1 (ssname listeligne compt))
                    (setq p1 (cdr (assoc 10 (entget ss1))))
                    (setq p2 (cdr (assoc 11 (entget ss1))))
                    (setq calq1 (cdr (assoc 8 (entget ss1))))
                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
                    (setq echl1 (cdr (assoc 48 (entget ss1))))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ang1 (angle ptinter p1))
                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
                    (setq angop (+ (- pi ang2) ang1))
                    (setq angok (- ang2 angop))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ptalong1 (polar ptinter angok 10000
                          ;;(/ 1000 techl)
                          ))
                    (setq ent (entget ss1))
                    (if (< (distance ptinter p1) (distance ptinter p2))
                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
                    )
                    (entmod ent)
                    (if (/= couleur1 nil)
                      (setvar "cecolor" (rtos couleur1 2 0))
                      (setvar "cecolor" "ducalque")
                    )
                    (if (/= typelig1 nil)
                      (setvar "celtype" typelig1)
                      (setvar "celtype" "ducalque")
                    )
                    (if (/= echl1 nil)
                      (setvar "celtscale" echl1)
                    )
                    (if (/= calq1 nil)
                      (setvar "clayer" calq1)
                    )
                    (command-s "ligne" ptinter ptalong1 "")
                    (setq couleur1 nil)
                    (setq typelig1 nil)
                    (setq echl1 nil)
                    (setq calq1 nil)
             )
             (setq compt (1+ compt))
           )
           (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "")
           (setvar "clayer" cav)
           (setvar "cecolor" cecol)
           (setvar "celtype" cety)
           (setvar "celtscale" celtsca)
           (setvar "osmode" osm)
           (command-s "scu" "P")
           (setvar "ucsfollow" ucsfo)
    )
  )
  (if (= typeactionreflet "6")
    (progn
;;;-----------------------------------------------------------
;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE et LA PROLONGE
;;;-----------------------------------------------------------
         ;;  (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
           (setvar "cmdecho" 0)
           (setq cav (getvar "clayer"))
           (setq osm (getvar "osmode"))
           (setq cecol (getvar "cecolor"))
           (setq cety (getvar "celtype"))
           (setq celtsca (getvar "celtscale"))
           (setq osm (getvar "osmode"))
           (setvar "osmode" 0)
           (prompt "SELECTIONNER LES LIGNES A REFRACTER et PROLONGER ( EN FAISANT UNE COPIE ) :")
           (setq listeligne nil)
           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "")
           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
           (setq p3 (cdr (assoc 10 (entget ss2))))
           (setq p4 (cdr (assoc 11 (entget ss2))))
           (setq ucsfo (getvar "ucsfollow"))
           (setvar "ucsfollow" 0)
           (command-s "scu" "")
           (setq compt 0)
           (setq com (sslength listeligne))
           (while (< compt com)
             (progn (setq ss1 (ssname listeligne compt))
                    (setq p1 (cdr (assoc 10 (entget ss1))))
                    (setq p2 (cdr (assoc 11 (entget ss1))))
                    (setq calq1 (cdr (assoc 8 (entget ss1))))
                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
                    (setq echl1 (cdr (assoc 48 (entget ss1))))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ang1 (angle p1 ptinter))
                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
                    (setq angop (+ (- pi ang2) ang1))
                    (setq angok (- ang2 angop))
                    (setq ptinter (inters p1 p2 p3 p4 nil))
                    (setq ptalong1 (polar ptinter angok 10000
                          ;;(/ 1000 techl)
                          ))
                    (setq ent (entget ss1))
                    (if (< (distance ptinter p1) (distance ptinter p2))
                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
                    )
                    (entmod ent)
                    (if (/= couleur1 nil)
                      (setvar "cecolor" (rtos couleur1 2 0))
                      (setvar "cecolor" "ducalque")
                    )
                    (if (/= typelig1 nil)
                      (setvar "celtype" typelig1)
                      (setvar "celtype" "ducalque")
                    )
                    (if (/= echl1 nil)
                      (setvar "celtscale" echl1)
                    )
                    (if (/= calq1 nil)
                      (setvar "clayer" calq1)
                    )
                    (command-s "ligne" ptinter ptalong1 "")
                    (setq couleur1 nil)
                    (setq typelig1 nil)
                    (setq echl1 nil)
                    (setq calq1 nil)
             )
             (setq compt (1+ compt))
           )
           (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "")
           (setvar "clayer" cav)
           (setvar "cecolor" cecol)
           (setvar "celtype" cety)
           (setvar "celtscale" celtsca)
           (setvar "osmode" osm)
           (command-s "scu" "P")
           (setvar "ucsfollow" ucsfo)
    )
  )
;;;  (if (= typeactionreflet "7")
;;;    (progn
;;;;;;-----------------------------------------------------------
;;;;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE et LA PROLONGE ET A JOINDRE
;;;;;;-----------------------------------------------------------
;;;           (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER")))
;;;           (setvar "cmdecho" 0)
;;;           (setq cav (getvar "clayer"))
;;;           (setq osm (getvar "osmode"))
;;;           (setq cecol (getvar "cecolor"))
;;;           (setq cety (getvar "celtype"))
;;;           (setq celtsca (getvar "celtscale"))
;;;           (setq osm (getvar "osmode"))
;;;           (setvar "osmode" 0)
;;;           (prompt "SELECTIONNER LES LIGNES A REFRACTER et PROLONGER et A JOINDRE( EN FAISANT UNE COPIE ) :")
;;;           (setq listeligne nil)
;;;           (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE")))))
;;;           (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE" "")
;;;           (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : ")))
;;;           (command-s "-calque" "ch" "0" "in" "T_ATT" "")
;;;           (setq p3 (cdr (assoc 10 (entget ss2))))
;;;           (setq p4 (cdr (assoc 11 (entget ss2))))
;;;           (setq ucsfo (getvar "ucsfollow"))
;;;           (setvar "ucsfollow" 0)
;;;           (command-s "scu" "")
;;;           (setq compt 0)
;;;           (setq com (sslength listeligne))
;;;           (while (< compt com)
;;;             (progn (setq ss1 (ssname listeligne compt))
;;;;;;           (command-s "COPIER" ss1 "" "0,0" "0,0")
;;;                    (setq p1 (cdr (assoc 10 (entget ss1))))
;;;                    (setq p2 (cdr (assoc 11 (entget ss1))))
;;;                    (setq calq1 (cdr (assoc 8 (entget ss1))))
;;;                    (setq typelig1 (cdr (assoc 6 (entget ss1))))
;;;                    (setq couleur1 (cdr (assoc 62 (entget ss1))))
;;;                    (setq echl1 (cdr (assoc 48 (entget ss1))))
;;;                    (setq ptinter (inters p1 p2 p3 p4 nil))
;;;                    (setq ang1 (angle p1 ptinter))
;;;                    (setq ang2 (min (angle p3 p4) (angle p4 p3)))
;;;                    (setq angop (+ (- pi ang2) ang1))
;;;                    (setq angok (- ang2 angop))
;;;                    (setq ptinter (inters p1 p2 p3 p4 nil))
;;;                    (setq ptalong1 (polar ptinter angok (/ 1000 techl)))
;;;                    (setq ent (entget ss1))
;;;                    (if (< (distance ptinter p1) (distance ptinter p2))
;;;                      (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent)))
;;;                      (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent)))
;;;                    )
;;;                    (entmod ent)
;;;                    (if (/= couleur1 nil)
;;;                      (setvar "cecolor" (rtos couleur1 2 0))
;;;                      (setvar "cecolor" "ducalque")
;;;                    )
;;;                    (if (/= typelig1 nil)
;;;                      (setvar "celtype" typelig1)
;;;                      (setvar "celtype" "ducalque")
;;;                    )
;;;                    (if (/= echl1 nil)
;;;                      (setvar "celtscale" echl1)
;;;                    )
;;;                    (if (/= calq1 nil)
;;;                      (setvar "clayer" calq1)
;;;                    )
;;;                    (command-s "ligne" ptinter ptalong1 "")
;;;                    (setq couleur1 nil)
;;;                    (setq typelig1 nil)
;;;                    (setq echl1 nil)
;;;                    (setq calq1 nil)
;;;                    (setq test102 entlast)
;;;                    (setq test103 (entget (entlast)))
;;;               (setq test301 (cdr (assoc -1 ent)))
;;;               (setq test300 (cdr (assoc -1 (entget (entlast)))))
;;;             
;;;                    (setq test205 (cdr (assoc -1 (entget (entlast)))))
;;;                    (setq test206 (cdr (assoc -1 ent)))
;;;                    (setq test104 (ssname (entlast)))
;;;                    (setq test204 (ssname ent))
;;;               
;;;;;;(setq ent (entget (ssname (entlast))))
;;;;;;           (setq nonent      (cdr (assoc -1 (entget (ssname (entlast)))))
;;;
;;;              
;;;
;;;
;;;                  
;;;;;;                    (command-s "JOINDRE" test104 test204 "")
;;;                    (command-s "JOINDRE" test301 test300 "")
;;;             )
;;;;;;    (command-s "effacer" ss1 "")
;;;             (setq compt (1+ compt))
;;;           )
;;;           (setvar "clayer" cav)
;;;           (setvar "cecolor" cecol)
;;;           (setvar "celtype" cety)
;;;           (setvar "celtscale" celtsca)
;;;           (setvar "osmode" osm)
;;;           (command-s "scu" "P")
;;;           (setvar "ucsfollow" ucsfo)
;;;    )
;;;  )
  (if (= typeactionreflet "8")
    (progn)
  )
  (princ)
)

 

[Max73]

Bonjour, et merci pour vos réponses.

Didier je ne suis pas de la génération de "ok google" et je peux comprendre que mes explication soient en peut brouillon et qu' il n'est pas simple de crée des lisp. j essaye de trouve un guide ou livre ou n importe quelle autre tutoriel pour apprendre le langue mais j ai un peut de mal. Et je te remercie de t intéresse a ma question.

Luna, je te remercie pour tes interrogation, les droit a 45 ou autre elle peuvent être sur n importe quelle calque et être des polyligne ou autre ce qui et plus facile et faisable pour un lisp.

Phiphi, je te remercie pour ce lisp je vais regarde cela, et effectivement je trace comme si c'était sur de papier a l ancien mais je trouve cela assez protique car je peur aligne toute mes coupes et reporte mes hauteur sans forcement me trompe en copiant des cotes.

[Luna]

Coucou,

Essaye quelque chose comme ceci :

(defun c:CH&VX (/ LM:intersections reversens check-properties line sens pt i)
  (defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if 
      (and
        (vlax-method-applicable-p ob1 'intersectwith)
        (vlax-method-applicable-p ob2 'intersectwith)
        (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      )
      (repeat (/ (length lst) 3)
        (setq
          rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
          lst (cdddr lst)
        )
      )
    )
    (reverse rtn)
  )
  
  (defun reversens (s / lst)
    (setq lst '("_Hor" "_Ver"))
    (car (vl-remove s lst))
  )
  
  (defun check-properties (name / check-line check-poly otype)
    (defun check-line (name / els pt1 pt2 ang)
      (and
        (setq els (entget name))
        (setq pt1 (cdr (assoc 10 els)))
        (setq pt2 (cdr (assoc 11 els)))
        (setq ang (+ (/ pi 4.) (angle (trans pt1 0 1) (trans pt2 0 1))))
        (or
          (equal 0.0 (rem ang (/ pi 2.)) 1E-12)
          (equal (/ pi 2.) (rem ang (/ pi 2.)) 1E-12)
        )
      )
    )
    
    (defun check-poly (name / els pt1 pt2 ang)
      (and
        (setq els (entget name))
        (= 2 (cdr (assoc 90 els)))
        (= 0.0 (cdr (assoc 42 els)))
        (setq pt1 (cdr (assoc 10 els)))
        (setq pt2 (cdr (assoc 10 (reverse els))))
        (setq ang (+ (/ pi 4.) (angle (trans pt1 0 1) (trans pt2 0 1))))
        (or
          (equal 0.0 (rem ang (/ pi 2.)) 1E-12)
          (equal (/ pi 2.) (rem ang (/ pi 2.)) 1E-12)
        )
      )
    )
    
    (if
      (and
        name
        (setq otype (cdr (assoc 0 (entget name))))
        (cond
          ( (= "LINE" otype) (check-line name))
          ( (= "LWPOLYLINE" otype) (check-poly name))
        )
      )
      name
    )
  )
  
  (while (setq line (check-properties (car (entsel "\nSélectionner une ligne à 45° :"))))
    (initget "Horizontales Verticales __Hor _Ver")
    (setq sens
      (cond
        ((getkword "\nLes droites passant par chaque point doivent être [Horizontales/Verticales] <Horizontales> ? "))
        ("_Hor")
      )
    )
    (while (setq pt (getpoint "\nSpécifier un point :"))
      (command "_XLINE" sens pt "")
      (setq i (LM:intersections (vlax-ename->vla-object line) (vlax-ename->vla-object (entlast)) acextendnone))
      (command "_XLINE" (reversens sens) (car i) "")
    )
  )
  (princ)
)

La commande s'appelle CH&VX (= Create Horizontal & Vertical Xlines). Le programme peut gérer les SCU, il faut en premier lieu sélectionner un segment à 45° par rapport au SCU (attention, car si tu n'es pas correctement à 45°, la ligne ne sera pas acceptée !), puis on définit si l'on veut projeter les points à l'horizontale (donc la droite passant par la vue de dessus sera horizontale et le programme va donc calculer la droite verticale) ou à la verticale (réflexion inverse). Puis il te suffit de cliquer sur autant de points que souhaité pour les projeter par rapport à ton segment à 45°. Si tu ne spécifies pas de point (ENTER uniquement), tu repars au début pour la sélection de la ligne à 45°.
J'ai testé sur ton .dwg et je n'ai pas trouvé d'erreur, après le programme ne peut pas faire la double projection Verticale > Horizontale > Verticale avec deux lignes à 45°. Du moins pas directement, car tu peux toujours faire une première projection Verticale (pour générer les droites horizontales) puis une projection Horizontale (pour générer les droites verticales) en changeant de ligne à 45° entre les deux 😉

Juste pour info, sur ton .dwg d'exemple les droites de construction étaient fausses pour la plupart ^^"

Bisous,
Luna

[didier]

Bonjour @Max73

Il va donc falloir que je me justifie*** encore et encore, quand je parle de "OK Google" je parle de la formulation des questions.
Tu poses ta question avec ton ressenti de la chose et tes habitudes de travail, ici tu ne parles pas à une Intelligence Artificielle.

Je reprends ta façon de faire qui ne me semble pas tout à fait pratique, en effet pour faire des élévations comme tu souhaites le faire, j'ai pris l'habitude de faire comme on faisait à la main dans le temps (avant OK Google hihihihi).
C'est-à-dire en prenant l'alignement de la façade à élever comme référence pour les perpendiculaires, il ne reste qu'à jouer dans les SCU de l'espace papier pour mettre le tout en ligne, car les façades élevées sont dans les quatre directions.

Puisque tu cherches à progresser en programmation, je me permets de te conseiller d'aller voir ce que je propose sur "da-code", en particulier il y a une page qui explique cette méthode d'élévation de façades.

Si tu veux faire l'élévation d'une porte depuis ton rectangle de base (qui représente un bâtiment je suppose), comment fais-tu ?

Amicalement

*** plus de vingt ans que je réponds sur ce site et j'ai encore besoin d'expliquer ma façon de parler, certes quelque peu directe, mais jamais méchante !

 

[Max73]

bonjour, 

LUNA c'est tout a fait ca que je voulais le lisp fonction très bien 😍. Bon après dommage qu' il ne peut pas faire les deux droite a 45 ° 🤣. Non je plaisant c'est super ca va beaucoup m aider.

PHILPHIL ton lisp et super aussi et je pense m an servir aussi .

DIDIER ou est ce que je peut trouver ton "Da-code" SVP. 

Merci a tous et désolé pour mes explications un peu vague. 😉