points de cotes ajouter soustraire

[PHILPHIL]

BONJOUR

 

mise a jour du LISP

 

a tester en attente d'avis

 

 

question aux experts et besoin d'aide

 

 

 

apparement ca manque de precision sur la recherche d'un point dans la liste

les 'trans" d'un SCU à un SCG a repetition font que les points ne sont plus exactement les meme

 

un point qui semble etre un doublons dans la liste a 8 chiffres apres la virgule

n'est pas trouver dans la liste et forme un doublons

 

comment trouver un point dans la liste avec un petit peu de marge ( ou marge definie a 8 chiffres apres la virgule par exemple ) pour eviter les doublons ?

 

voir lisp

 

merci

phil

 

 

 ;;---------------------------------
;;;ajouter/soustraire  des point dans des cotes
;;---------------------------------


(defun C:ASPC ()
 (vl-load-com)
 (setq OSM (getvar "osmode"))
 (setq CAV (getvar "clayer"))
 (setq STYLECOTEENCOURS (getvar "DIMSTYLE"))
 (setvar "osmode" 0)
;;;  (command "scu" "")
 (prompt
   "CLIQUER 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"))
 )
;;;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))
;;;  (prompt (strcat "\nL'ANGLE DE LA COTE EST : " ANGCOTEDEGRE))
; 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" "")
;;;  (vl-cmdf "-calque" "ch" 0 "")
 (repeat (sslength ENTG1)
   (setq POINT13 (trans (cdr (assoc 13 (entget (ssname ENTG1 COMPT)))) 0 1)
  POINT14 (trans (cdr (assoc 14 (entget (ssname ENTG1 COMPT)))) 0 1)
   )
   (if	(= (member point13 listpoint) nil)
     (progn (setq listpoint (cons point13 listpoint))
     (vl-cmdf "point" point13)
     (ssadd (entlast) croix)
     )
   )
   (if	(= (member point14 listpoint) nil)
     (progn (setq listpoint (cons point14 listpoint))
     (vl-cmdf "point" point14)
     (ssadd (entlast) croix)
     )
   )
   (setq COMPT (1+ COMPT))
 )
 (setq	rep 0
;;;	reponse	"Q"
 )
 (while (= rep 0)
   (INITGET "a A s S q Q")
   (setq reponse
   (GETKWORD "\nSELECTIONNER Ajouter Supprimer ou : "
   )
   )
;;;    (prompt (strcat "\nLa reponse est : " reponse))
   (if	(or (= reponse "a") (= reponse "A"))
     (PROGN ;;(AJOUTERPOINT)
     (vl-cmdf "ORDRETRACE" croix "" "AR")
     (setvar "osmode" OSM)
     (setq poi nil)
     (while (null POI)
       (setq POI (getpoint "\nNOUVEAU POINT DE COTE :"))
     )
     (if (= (member poi listpoint) nil)
       (progn (setq listpoint (cons poi listpoint))
	      (vl-cmdf "ligne"
		       (polar poi (/ pi 4) 10)
		       (polar poi (+ pi (/ pi 4)) 10)
		       ""
	      )
	      (ssadd (entlast) croix)
	      (vl-cmdf "ligne"
		       (polar poi (- pi (/ pi 4)) 10)
		       (polar poi (- (+ pi pi) (/ pi 4)) 10)
		       ""
	      )
	      (ssadd (entlast) croix)
;;;		      (setq reponse "q")
       )
     )
     )
     (setvar "osmode" 0)
   )
   (if	(or (= reponse "s") (= reponse "S"))
     (progn
;;	(SUPPRIMERPOINT)
(vl-cmdf "ORDRETRACE" croix "" "AV")
(setvar "osmode" 8)
(setq poi nil)
(while (null POI)
  (setq POI (getpoint "\nPOINT DE COTE A SUPPRIMER:"))
)
(if (= (member poi listpoint) nil)
  (progn (prompt
	   "\nLE POINT NE FAIT PAS PARTIE DE LA LISTE PREDEFINIE"
	 )
;;;		 (command "cercle" poi 20)
  )
  (progn (prompt "\nLE POINT FAIT PARTIE DE LA LISTE PREDEFINIE")
	 (setq
	   listpoint (append (cdr (member poi (reverse listpoint)))
			     (cdr (member poi listpoint))
		     )
	 )
  )
)
(setvar "osmode" 0)
     )
   )
   (if	(or (= reponse "q") (= reponse "Q"))
     (progn (setq rep 1) (command "zoom" "OB" ENTG1 croix ""))
   )
 )
 ;;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")
 (setvar "osmode" OSM)
 (setvar "clayer" CAV)
 (vl-cmdf "-dimstyle" "R" STYLECOTEENCOURS)
 (princ)
)

 

[Edité le 27/5/2008 par PHILPHIL]

[Bred]

Salut,

comment trouver un point dans la liste avec un petit peu de marge ( ou marge definie a 8 chiffres apres la virgule par exemple ) pour eviter les doublons ?

Avec equal, qui accepte un tolérance :

 

(equal x y 1e-8)