POINTS DE COTE AJOUTER SOUSTRAIRE

[PHILPHIL]

HELLO

 

petite mise a jour pour verification aupres des lispeurs et autocadiennes, autocadiens

 

si vous trouvez des bugs je veux bien etre au courant et avoir votre avis

ca peut servir

 

ceci avant un netoyage du LISP

 

 

merci à gile et ceux que j'oublie qui reconnaitront des bouts de LISP

 

phil

 

 ;;;;----------------------------------------------
;;;ajouter/soustraire  des points dans des cotes
;;;   le  11 07 2008                            
;;----------------------------------------------


(DEFUN C:ASPC ()
 (VL-LOAD-COM)
  [surligneur] (SETQ OSM (GETVAR "osmode"))[/surligneur]
 (SETQ CAV (GETVAR "clayer"))
 (SETQ VARPDMODE (GETVAR "pdmode"))
 (SETQ VARPDSIZE (GETVAR "pdsize"))
 (SETQ STYLECOTEENCOURS (GETVAR "DIMSTYLE"))
 (SETVAR "osmode" 0)
 (SETVAR "pdmode" 3)
 (SETVAR "pdsize" 0)
 (PROMPT "\nCLIQUER SUR LA COTE(S) A MODIFIER (1ere COTE SELECTIONNER = COTE DE BASE ) :")
 (SETQ ENTG1 NIL)
 (WHILE (NULL ENTG1) (SETQ ENTG1 (SSGET '((0 . "DIMENSION")))))
 (COMMAND "zoom" "OB" ENTG1 "")
;;;debut recuperation de donnee de la cote de base
 (SETQ	POINT10	  (TRANS (CDR (ASSOC 10 (ENTGET (SSNAME ENTG1 0)))) 0 1)
STYLECOTE (CDR (ASSOC 3 (ENTGET (SSNAME ENTG1 0))))
CALQCOTE  (CDR (ASSOC 8 (ENTGET (SSNAME ENTG1 0))))
ANGCOTE	  (CDR (ASSOC 50 (ENTGET (SSNAME ENTG1 0))))
ASX1	  (CAR (GETVAR "ucsxdir"))
ASX2	  (CADR (GETVAR "ucsxdir"))
FUZZ	  1e-10
 )
;;;fin recuperation de donnee de la cote de base
;;;calcul de l'angle du SCU par rapport au SCG
 (IF (AND (= ASX1 1) (= ASX2 0))
   (SETQ ANGSCU 0)
 )
 (IF (AND (AND (< ASX1 1) (> ASX1 0)) (AND (< ASX2 1) (> ASX2 0)))
   (SETQ ANGSCU (ATAN (/ ASX2 ASX1)))
 )
 (IF (AND (= ASX1 0) (= ASX2 1))
   (SETQ ANGSCU (/ PI 2))
 )
 (IF (AND (AND (< ASX1 0) (> ASX1 -1)) (AND (< ASX2 1) (> ASX2 0)))
   (SETQ ANGSCU (- (ATAN (/ ASX2 ASX1)) PI))
 )
 (IF (AND (= ASX1 -1) (= ASX2 0))
   (SETQ ANGSCU (* 2 PI))
 )
 (IF (AND (AND (< ASX1 0) (> ASX1 -1)) (AND (< ASX2 0) (> ASX2 -1)))
   (SETQ ANGSCU (+ (ATAN (/ ASX2 ASX1)) PI))
 )
 (IF (AND (= ASX1 0) (= ASX2 -1))
   (SETQ ANGSCU (+ PI (/ PI 2)))
 )
 (IF (AND (AND (< ASX1 1) (> ASX1 0)) (AND (< ASX2 0) (> ASX2 -1)))
   (SETQ ANGSCU (ATAN (/ ASX2 ASX1)))
 )
;;;fin de calcul de l'angle du SCU par rapport au SCG
 (SETQ ANG (- ANGCOTE ANGSCU))
 ;;calcul de l'angle de la cote dans le SCU
 (SETQ ANGCOTEDEGRE (ANGTOS (- ANGCOTE ANGSCU) 0 10)) ; fin de calcul de l'angle de la cote dans le SCU
 ;;recuperation des points de cotes dans uns liste
 (SETQ COMPT 0)
 (SETQ LISTPOINT NIL)
 (SETQ CROIX (SSADD))
 (VL-CMDF "-calque" "n" "T_CROIX" "co" "52" "T_CROIX" "ch" "T_CROIX" "")
 (REPEAT (SSLENGTH ENTG1)
   (IF	(= (MEMBER-FUZZ (TRANS (CDR (ASSOC 13 (ENTGET (SSNAME ENTG1 COMPT)))) 0 1) LISTPOINT FUZZ) NIL)
     (SETQ LISTPOINT (CONS (TRANS (CDR (ASSOC 13 (ENTGET (SSNAME ENTG1 COMPT)))) 0 1) LISTPOINT))
   )
   (IF	(= (MEMBER-FUZZ (TRANS (CDR (ASSOC 14 (ENTGET (SSNAME ENTG1 COMPT)))) 0 1) LISTPOINT FUZZ) NIL)
     (SETQ LISTPOINT (CONS (TRANS (CDR (ASSOC 14 (ENTGET (SSNAME ENTG1 COMPT)))) 0 1) LISTPOINT))
   )
   (SETQ COMPT (1+ COMPT))
 )
 (SETQ LISTPOINT (REMOVE_DOUBLES LISTPOINT))
 (SETQ COMPT 0)
 (REPEAT (LENGTH LISTPOINT)
   (VL-CMDF "point" (NTH COMPT LISTPOINT))
   (SSADD (ENTLAST) CROIX)
   (SETQ COMPT (1+ COMPT))
 )
 (SETQ NBCROIXDB (SSLENGTH CROIX))
 (SETQ REP 0)
 (WHILE (= REP 0)
   (INITGET "a A s S q Q")
;;;(PROMPT (STRCAT "\nLE NOMBRE DE CROIX EST DE " (RTOS (SSLENGTH CROIX) 2 0)))
   (SETQ REPONSE (GETKWORD "\nSELECTIONNER Ajouter Supprimer ou < Quitter >: "))
   (IF	(OR (= REPONSE "a") (= REPONSE "A"))
     (PROGN (VL-CMDF "ORDRETRACE" CROIX "" "AR")
      [surligneur] (SETVAR "osmode" OSM)[/surligneur]
     (SETQ POI NIL)
     (WHILE (NULL POI) (SETQ POI (GETPOINT "\nNOUVEAU POINT DE COTE :")))
      [surligneur] (SETVAR "osmode" 0)[/surligneur]
     (IF (= (MEMBER-FUZZ POI LISTPOINT FUZZ) NIL)
       (PROGN (SETQ LISTPOINT (CONS POI LISTPOINT))
	      (VL-CMDF "point" POI)
	      (SSADD (ENTLAST) CROIX)
	      (SETQ LISTPOINT (REMOVE_DOUBLES LISTPOINT))
       )
;;;	       (PROMPT "\nLE POINT FAIT PARTIE DE LA LISTE PREDEFINIE")
     )
     )
   )
   (IF	(OR (= REPONSE "s") (= REPONSE "S"))
     (PROGN (VL-CMDF "ORDRETRACE" CROIX "" "AV")
      [surligneur] (SETVAR "osmode" 8)[/surligneur]
     (SETQ POI NIL
	   REPONSEPOI NIL
	   DEBUTLISTE NIL
	   FINLISTE NIL
     )
;;;	     (SETVAR "regenmode" 0)
;;;	     (COMMAND "-calque" "v" "*" "d" "T_CROIX" "")
     (WHILE (NULL POI) (SETQ POI (GETPOINT "\nPOINT DE COTE A SUPPRIMER:")))
      [surligneur] (SETVAR "osmode" 0)[/surligneur]
;;;	     (SETQ REPONSEPOI (MEMBER-FUZZ POI LISTPOINT FUZZ))
;;;	     (IF (= REPONSEPOI NIL)
     (IF (/= (MEMBER-FUZZ POI LISTPOINT FUZZ) NIL)
       ;;  (PROGN (PROMPT "\nLE POINT NE FAIT PAS PARTIE DE LA LISTE PREDEFINIE"))
       (PROGN ;; (PROMPT "\nLE POINT FAIT PARTIE DE LA LISTE PREDEFINIE")
	      (SETQ
;;;			DEBUTLISTE (TRUNC-FUZZ POI LISTPOINT FUZZ)
;;;			    FINLISTE   (CDR (MEMBER-FUZZ POI LISTPOINT FUZZ))
;;;			    LISTPOINT1 (APPEND DEBUTLISTE FINLISTE)
		    LISTPOINT
		     (APPEND (TRUNC-FUZZ POI LISTPOINT FUZZ) (CDR (MEMBER-FUZZ POI LISTPOINT FUZZ)))
	      )
	      (SETQ COMPT1  1
		    COMPT2  NIL
		    NBCROIX (SSLENGTH CROIX)
	      )
	      (WHILE (<= COMPT1 NBCROIX)
		(SETQ P1 (TRANS (CDR (ASSOC 10 (ENTGET (SSNAME CROIX COMPT1)))) 0 1))
		(IF (EQUAL POI P1 FUZZ)
		  (PROGN ;;  (PROMPT "\nLE POINT EST DANS LA LISTE DE CROIX")
;;;			    (SETQ COMPT2 COMPT1)
			 (VL-CMDF "effacer" (SSNAME CROIX COMPT1) "")
			 (SSDEL (SSNAME CROIX COMPT1) CROIX)
			 (SETQ COMPT1 (1+ NBCROIX))
		  )
	;;	  (PROMPT "\nLE POINT N'EST PAS DANS LA LISTE DE CROIX")
		)
		(SETQ COMPT1 (1+ COMPT1))
	      )
;;;		      (IF (/= COMPT2 NIL)
;;;			(PROGN (VL-CMDF "effacer" (SSNAME CROIX COMPT2) "")
;;;			(SSDEL (SSNAME CROIX COMPT2) CROIX))
       )
     )
;;;      )
     (COMMAND "-calque" "d" "*" "")
     (SETQ LISTPOINT (REMOVE_DOUBLES LISTPOINT))
     )
   )
   (IF	(OR (= REPONSE "q") (= REPONSE "Q"))
     (PROGN (SETQ REP 1)
     (COMMAND "zoom" "OB" ENTG1 CROIX "")
     (SETQ LISTPOINT (REMOVE_DOUBLES LISTPOINT))
     )
   )
 )
 ;;refaire la liste des points dans le scg
 (SETQ LISTPOINTA NIL)
 (SETQ COMPT 0)
 (REPEAT (LENGTH LISTPOINT)
   (SETQ LISTPOINTA (CONS (TRANS (NTH COMPT LISTPOINT) 1 0) LISTPOINTA))
   (SETQ COMPT (1+ COMPT))
 )
 ;;fin de la liste en SCG
 ;;passer dans le SCU de la cote
 (COMMAND "scu" "z" '(0 0) (POLAR '(0 0) ANG 10))
 ;;refaire la liste des points dans le scu de la cote de base
 (SETQ LISTPOINTC NIL)
 (SETQ COMPT 0)
 (REPEAT (LENGTH LISTPOINTA)
   (SETQ LISTPOINTC (CONS (TRANS (NTH COMPT LISTPOINTA) 0 1) LISTPOINTC))
   (SETQ COMPT (1+ COMPT))
 )
 ;;fin de la liste en SCU de la cote de base
 ;;faire la liste en ordre croissant par rapport a l'angle de la cote de base
 (SETQ LISTPOINTX (VL-SORT LISTPOINTC (FUNCTION (LAMBDA (P1 P2) (< (CAR P1) (CAR P2))))))
;;;fin de la mise en ordre croissant
 ;;refaire la liste des points dans le scg
 (SETQ LISTPOINTB NIL)
 (SETQ COMPT 0)
 (REPEAT (LENGTH LISTPOINTX)
   (SETQ LISTPOINTB (CONS (TRANS (NTH COMPT LISTPOINTX) 1 0) LISTPOINTB))
   (SETQ COMPT (1+ COMPT))
 )
 ;;fin de la liste en SCG
 ;;repasser dans le scu de vue
 (VL-CMDF "scu" "p")
 ;;   point11  dans l'alignement de la ligne de cote de base
 (SETQ POINT11 (POLAR POINT10 ANG 500))
 ;;fin du point11
;;;passer dans les donnees de base
 (VL-CMDF "effacer" ENTG1 "")
 (VL-CMDF "effacer" CROIX "")
 (VL-CMDF "-calque" "ch" CALQCOTE "")
 (VL-CMDF "-dimstyle" "R" STYLECOTE)
 ;;fin de donner de base
;;;refaire les cotes
 (SETQ COMPT 0)
 (REPEAT (1- (LENGTH LISTPOINTB))
   (SETQ POINT13A (TRANS (NTH COMPT LISTPOINTB) 0 1)
  POINT14A (TRANS (NTH (1+ COMPT) LISTPOINTB) 0 1)
   )
   (IF	(OR (AND (< (SIN (- (ANGLE POINT13A POINT10) (ANGLE POINT11 POINT10))) 0)
	 (< (SIN (- (ANGLE POINT14A POINT10) (ANGLE POINT11 POINT10))) 0)
    )
    (AND (> (SIN (- (ANGLE POINT13A POINT10) (ANGLE POINT11 POINT10))) 0)
	 (> (SIN (- (ANGLE POINT14A POINT10) (ANGLE POINT11 POINT10))) 0)
    )
)
     (VL-CMDF "cotlin" POINT13A POINT14A "R" ANGCOTEDEGRE POINT10)
     (VL-CMDF "cotlin" POINT13A POINT14A "R" ANGCOTEDEGRE (INTERS POINT10 POINT11 POINT13A POINT14A NIL))
   )
   (SETQ COMPT (1+ COMPT))
 )
 ;;fin de refaire les cotes
 (VL-CMDF "-purger" "ca" "T_CROIX" "n")
  [surligneur] (SETVAR "osmode" OSM)[/surligneur]
 (SETVAR "clayer" CAV)
 (SETVAR "pdmode" VARPDMODE)
 (SETVAR "pdsize" VARPDSIZE)
 (VL-CMDF "-dimstyle" "R" STYLECOTEENCOURS)
 (PRINC)
)






(DEFUN MEMBER-FUZZ (EXPR LST FUZZ)
 (WHILE (AND LST (NOT (EQUAL EXPR (CAR LST) FUZZ))) (SETQ LST (CDR LST)))
)

(DEFUN TRUNC-FUZZ (EXPR LST FUZZ)
 (IF (AND LST (NOT (EQUAL EXPR (CAR LST) FUZZ)))
   (CONS (CAR LST) (TRUNC-FUZZ EXPR (CDR LST) FUZZ))
 )
)


;;; REMOVE_DOUBLES - Suprime tous les doublons d'une liste

(DEFUN REMOVE_DOUBLES (LST)
 (IF LST
   (CONS (CAR LST) (REMOVE_DOUBLES (VL-REMOVE (CAR LST) LST)))
 )
)


;;; MID_PT Retourne le milieu de deux points

(DEFUN MID_PT (P1 P2) (MAPCAR '(LAMBDA (X1 X2) (/ (+ X1 X2) 2)) P1 P2))

 

 

 

[Edité le 10/7/2008 par PHILPHIL][Edité le 10/7/2008 par PHILPHIL][Edité le 10/7/2008 par PHILPHIL]

 

[Edité le 11/7/2008 par PHILPHIL]

[lili2006]

Bonsoir à toutes et tous,

 

Désolé PHILPHIL, je n'ai pas compris l'utilisation !

[PHILPHIL]

hello lili

 

tu lances la fonction avec "ASPC"

 

tu selectionnes une cote , ou des cotes

tu valides

 

tu tappes

A et valider pour ajouter de point de cotes n'importe ou en cliquant

S et valider pour supprimer un point de cotes en cliquant sur les croix ( points ) jaunes

Q et valider pour quitter

 

apres quitter ca reconstruit les cotes avec les nouveaux points

 

il faut que le style des points soit sur 5% et une croix visibles aux choix

 

si tu selectionnes des cotes qui ne sont pas sur la meme ligne

la premiere cote selectionner sert de base et toutes les cotes seront aligner a celle ci

 

une fois les test et tortures convinquantes je retirrais les lignes de verification

du nombres de croix

ou de verifications de liste

 

phil

 

 

 

 

 

[Edité le 10/7/2008 par PHILPHIL]

[bonuscad]

Bonsoir,

 

Je l'ai quand même essayé, j'ai eu un peu de mal à comprendre la démarche.

 

Une fois compris, il fonctionne (sans avoir cherché a être dans des cas particuliers)

 

Un gros reproche; tu ne spécifie pas comment on sort de ta boucle Ajouter Supprimer.

Il a fallu que je jette un œil au lisp pour savoir qu'il fallait tapes "Q" (comme quitter)

 

Je trouve que sélectionner les points d'attaches pour la suppression n'est pas le top (on ne sait pas forcément où ils sont), sélectionner la cote serait plus simple.

 

L'idée est bonne, le code semble fonctionner, c'est un très bon début. Je pense que cela pourrait être allégé mais je n'ai rien décortiqué. Mes remarques s'arrêtent à l'utilisation pure et simple.

 

Bon courage ;)

[lili2006]

Re,

 

Forcément, j'avais pas de format sur mes points et bien sûr pas compris qu'il fallait les rpérer,...

 

Quand je selectionne A ou S, je perd les accrochages objets,...

 

Sinon, cette routine remplie bien son rôle est l'idée est très intéressante.

 

Mes remarques s'arrêtent à l'utilisation pure et simple.

 

Moi aussi par manque de maitrise, ;)

 

Je rejoint un peu bonuscad dans ces commentaires mais aussi pour les félicitations,.. :P

[PHILPHIL]

hello

 

comme je le disais a lili

 

pour le test il faut que le type des points soit sur 5% et force pour faire une croix

 

car en fait il y a une croix de couleur ocre creer sur chaque point de cote

plus facile pour les reperer

 

et juste avant d'ajouter soustraire il y a un zoom sur toutes les cotes pour etre sur de voir tous les points

 

en ce qui concerne le gros repproche c'est le passage a la moulinette sur le site qui a effacer ce qu'il y a entre "<" et ">" je vais refaire ca

 

pas top de tapper a chaque fois sur "A" ou "S" pour ajouter ou soustraire j'en conviens

prochaines etape faire en sorte de cliquer a la volée ( plusieurs points en emme tps ) pour ajouter ou soustraire

 

pour alleger le lisp va y avoir du boulot ou un expert ( pas moi )

 

phil

[lili2006]

Bonjour à toutes et tous,

 

Quand je selectionne A ou S, je perd les accrochages objets,...

 

Y'à que chez moi ?

 

Sinon, testé "grandeur nature" sur un plan de fondations modifié, le code fonctionne !!!

 

Comme le dis bonuscad, selectionner la cote pourrait être pratique, ;)

 

Beau travail PHILPHIL

[PHILPHIL]

hello

 

pour l'accrochage objet la variable "osmode"

est enregistrer des le debut

 

puis mis a séro pour sélectionner la ou les cotes

quand tu sélectionnes "A" osmode revient a ta version de base pour accroche puis de nouveau zéro

 

quand tu sélectionnes "S" osmode se met sur accroche au point ( variable sur 8 ) puis de nouveau zéro

 

puis avec "Q" quitter a la fin osmode revient a la variable enregistrer au début

 

le but du lisp est de récuperer une liste de points de cotes pour refaire toutes les cotes suivant le scu

 

si on selectionne la cote pour supprimer des points, il faut ensuite choisir quel point de la cote doit disparaitre le gauche ou le droit ( le 13 ou le 14 )

des fois les cotes sont aussi "miroiter" le 13 est a droite et le 14 a gauche ou inversement

 

et puis sur deux cotes en continue en general elles ont un point en commun d'accroche

 

phil

[lili2006]

Re,

 

Ok PHILPHIL,

 

Merci pour ces précisions !

 

Donc, quand j'ai lancé le lisp, mes accrochages objets étaient désactivées,...