Doublon dans les matricules

[willy95]

Bonjour cher utilisateur de Covadis,

 

Existe-il une option dans Covadis pour que les points avec un même matricule puissent être automatiquement

"renommés" (rajout d'un radical en plus) ?

Je souhaite conserver les 2 points qui n'ont pas forcement les mêmes valeurs, voir mettre les doublons en evidence.

 

par exemple :

 

Point 1 : Matricule 1

Point 1 : Matricule D.1

 

Merci par avance pour toutes vos éventuelles réponse.

[ptisylvain]

Bonjour,

 

Cov Edition > Points topo > Reimmatriculation > Ajouter avant les radicaux : D

 

Normalement, s'il y a 2 points "1", il y en a un qui reste "1" et l'autre qui se réimmatricule "D.1"

 

Sincèrement.

[ptisylvain]

Et s'il y a 3 points "1", refaire la même opération et on obtient :

un point "1"

un point "D.1"

un point "DD.1"

[vincentp010]

Salut,

 

j'avais fait ce lisp il y a très longtemps pour voir les points avec le même matricule.

Il fait des lignes qui relient les points doubles afin de les voir plus facilement.

Ensuite il suffit de reimatriculer un des deux points.

 

(defun c:ptdouble ()
  (setvar "cmdecho" 0)
  (command "_.undo" "_m")
  (command "_ucs" "")
  (setq lst nil)

(setq pl (ssget "x" (list (cons 8 "ptdouble"))))
(if (/= pl nil) (command "effacer" pl ""))


(setq ent (ssget "x" (list '(-4 . "<OR") (cons 2 "tcpoint") (cons 2 "topojis") '(-4 . "OR>"))))
  (if (= ent nil) (exit))
 (setq nb (sslength ent))
  (setq nb1 0)
  (while (< nb1 nb)
   (setq ent2 (ssname ent nb1))
   (setq ins (cdr (assoc 10 (entget ent2))))
   (setq matr (cdr (assoc 1 (entget (entnext ent2)))))
   (setq pt (cons matr ins))
   (setq lst (cons pt lst))

   (setq nb1 (+ nb1 1))
  )

;ordre croissant suivant premiere entite
(setq lst (vl-sort lst
 (function
 (lambda (e1 e2) (< (car e1) (car e2))))))
;

(setq nb1 0)
(while (< nb1 nb)
(setq mat1 (car (nth nb1 lst)))
(setq mat2 (car (nth (+ nb1 1) lst)))
(setq ins1 (cdr (nth nb1 lst)))
(setq ins2 (cdr (nth (+ nb1 1) lst)))
(if (= mat1 mat2) (progn
 (command "_-layer" "_m" "ptdouble" "_co" "1" "" "")
 (if (equal ins1 ins2 0.05)
  (command "_circle" ins1 "5")
 (progn
  (command "_circle" ins1 "10")
  (command "_circle" ins2 "10")
  (command "_line" ins1 ins2 ""))
 )
))
(setq nb1 (+ nb1 1))
)

(setq cer (ssget "x" (list (cons 0 "CIRCLE") (cons 8 "ptdouble"))))
(if (/= cer nil) (setq nb (sslength cer)) (setq nb 0))
(setq lin (ssget "x" (list (cons 0 "LINE") (cons 8 "ptdouble"))))
(if (/= lin nil) (setq nb1 (sslength lin)) (setq nb1 0))
(command "_ucs" "_p")

(if (and (tblsearch "LAYER" "ptdouble") (not cer) (not lin)) (progn
 (command "_-layer" "_s" "0" "")
 (command "_-purge" "_la" "ptdouble" "_n")
))

(print)
(princ nb)
(princ " cercles ptdouble et ")
(princ nb1)
(princ " lignes ptdouble")
(print)


)