Changer le calque de courbes de niveau selon leurs altitudes

[Nicky]

Bonjour a toutes et tous,

J'ai un petit problème avec le code ci dessous :

La routine permet en choisissant un multiple d'altitude (0.5/1/2/5/10/25/50/100 mètres) de placer dans un (nouveau) calque les courbes de niveau (situées dans un calque originel) répondant au critère.

Cependant, depuis peu, certaine courbe ne se place pas dans le nouveau calque alors que le critère est respecté (les altitudes affichées dans les propriétés sont juste).

Il y a peut être une erreur dans le code, ou une variable a modifier (précision ou arrondi proche par exemple..) ?

Merci,

 

(defun c:MAJCL (
					;/ elev ss i el
	       )
  (vl-load-com)
  (setq Valer (getvar "luprec"))
  (setvar "luprec" 0)
  (initget 1 "0.5 1 2 5 10 25 50 100")
  (setq
    elev (getkword
	   "\nSelect String for filter [0.5/1/2/5/10/25/50/100]: "
	 )
  )
  (setq
    LayerCL (car
	      (entsel
		"\nClick on a layer with contour lines to modify : "
	      )
	    )
  )
  (setq EntLay (entget LayerCL))
  (setq LAY (cdr (assoc 8 EntLay)))
  (setq nomcalc (strcat "_NB-MajorLine_" elev))
  (initget 1 "Blue Green GRey Pink Red White Yellow Other")
  (setq
    ColorCalc
     (getkword
       "\nSelect a color for the layer [Blue/Green/GRey/Pink/Red/White/Yellow/Other]: "
     )
  )
  (cond	((= ColorCalc "Blue")
	 (setq Color 141)
	)
	((= ColorCalc "Green")
	 (setq Color 91)
	)
	((= ColorCalc "GRey")
	 (setq Color 253)
	)
	((= ColorCalc "Pink")
	 (setq Color 211)
	)
	((= ColorCalc "Red")
	 (setq Color 241)
	)
	((= ColorCalc "White")
	 (setq Color 7)
	)
	((= ColorCalc "Yellow")
	 (setq Color 51)
	)
	((= ColorCalc "Other")
	 (setq Color 121)
	)
  )
  (if (not (tblsearch "LAYER" nomcalc))
    (entmake
      (list
	(cons 0 "LAYER")
	(cons 100 "AcDbSymbolTableRecord")
	(cons 100 "AcDbLayerTableRecord")
	(cons 2 nomcalc)
	(cons 70 0)
	(cons 62 Color)
	(cons 370 -3)
	(cons 6 "Continuous")
      )
    )
  )
  (if (setq ss (ssget "_X"
		      (list (cons 0 "LWPOLYLINE") (cons 8 LAY))
	       )
      )
    (repeat (setq i (sslength ss))
      (setq
	el (cdr
	     (assoc 38 (entget (setq e (ssname ss (setq i (1- i))))))
	   )
      )
      (if (equal (distof (rtos (rem el (distof elev)) 2 2)) 0.0 1e-6)
					; at elevation that is a multiple of elev?
	(vla-put-Layer (vlax-ename->vla-object e) nomcalc)
					;(command "_.chprop" e "" "_layer" nomcalc "")
      )					; if
    )					; repeat
  )					; if
  (setvar "luprec" Valer)
  (princ)
)

 

[Olivier Eckmann]

Bonjour,

 

Sans un fichier DWG qui pose problème, ça risque d'être compliqué.

J'ai testé sans souci avec un pas de 0.5.

 

Olivier

[Nicky]

Bonjour Olivier,

effectivement, voici un dwg qui pose problème avec les pas de 1, 5 et 25.

Pour information, il s'agit d'un fichier en mètres converti en feet avec la commande suivante.

(defun c:SCFTM ()
  (command "insunits" 6)
  (command "_units" 2 3 1 1 0 "N")
  (setq selec (ssget "_X"))
  (command "-dwgunits" 2 2 4 "yes" "no" "yes" "no")
;;(command "_.scale" selec "" '(0 0 0) 1000)
  (command "_.zoom" "e")
;;  (command "_units" 2 3 1 1 0 "N")
  (command "insunits" 2)
)

Bien que les courbes de niveau soit a la bonne altitude (a 4 décimales près), je me demande si le problème n'aurait pas quelque chose a voir avec la valeur de l'arrondi de l'élévation des polylignes (courbes de niveau)..?

Merci,

Crooked Mile export mensura test.dwg

[Olivier Eckmann]

L'égalité de la valeur d'altitude est faite à 10 E-6 c'est à dire sur la 6ème décimale.

Dans cette ligne 

      (if (equal (distof (rtos (rem el (distof elev)) 2 2)) 0.0 1e-6)

remplacer 1e-6 par 1e-4 si vous voulez valider à la 4ème décimale

      (if (equal (distof (rtos (rem el (distof elev)) 2 2)) 0.0 1e-4)

 

[Olivier Eckmann]

Effectivement, on a une élévation qui diffère de la cote ronde ce qui engendre un reste non nul.

remplacer la ligne 

     (if (equal (distof (rtos (rem el (distof elev)) 2 2)) 0.0 1e-6)

par 

(if (equal (distof (rtos (rem (atof (rtos el 2 2)) (distof elev)) 2 2)) 0.0 1e-6)

 

[bonuscad]

Bonjour,

Je t’ai répondu ICI.

Je remet ici ma proposition en ayant amélioré le code: établissement du calque avec sa couleur et affectation de l'élévation avec les décimales arrondies aux polylignes (tant qu'à faire)

https://www.cadtutor.net/forum/topic/92684-change-contour-line-layer-according-to-altitude/?do=findComment&comment=654523
(defun c:MAJCL ( / ss l c n dxf_ent elev nam_lay)
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Terrain - Cont. - Contours"))))
  (cond
    (ss
      (setq
        l '(0.5 1.0 2.0 5.0 10.0 25.0 50.0 100.0)
        c '(121 51 7 241 211 253 91 141)
      )
      (repeat (setq n (sslength ss))
        (setq
          dxf_ent (entget (ssname ss (setq n (1- n))))
          elev (read (rtos (cdr (assoc 38 dxf_ent)) 2 1))
        )
        (mapcar
          '(lambda (x)
            (if (and (zerop (rem elev (car x))) (null (assoc 62 dxf_ent)))
              (progn
                (setq nam_lay (strcat "_NB-MajorLine_" (if (eq (car x) (fix (car x))) (rtos (car x) 2 0) (rtos (car x) 2 1))))
                (if (not (tblsearch "LAYER" nam_lay))
                  (entmake
                    (list
                      (cons 0 "LAYER")
                      (cons 100 "AcDbSymbolTableRecord")
                      (cons 100 "AcDbLayerTableRecord")
                      (cons 2 nam_lay)
                      (cons 70 0)
                      (cons 62 (cdr x))
                      (cons 370 -3)
                      (cons 6 "Continuous")
                    )
                  )
                )
                (setq
                  dxf_ent
                  (subst
                    (cons 8 nam_lay)
                    (assoc 8 dxf_ent)
                    dxf_ent
                  )
                  dxf_ent
                  (subst
                    (cons 38 elev)
                    (assoc 38 dxf_ent)
                    dxf_ent
                  )
                )
                (entmod dxf_ent)
              )
            )
          )
          (mapcar 'cons l c)
        )
      )
    )
  )
)