Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Changer le calque de courbes de niveau selon leurs altitudes

Nicky

Par Nicky
dans LISP et Visual LISP

 Partager

Messages recommandés

Nicky Apprentice

Nicky

Posté(e)
Posté(e)

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)
)

 

Nicky Apprentice

Nicky

Posté(e)
  • Auteur
Posté(e)

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 Proficient

Olivier Eckmann

Posté(e)
Posté(e)

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 Proficient

Olivier Eckmann

Posté(e)
Posté(e)

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)

 

  • Upvote 1
bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

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)
        )
      )
    )
  )
)

 

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Nicky Apprentice

Nicky

Posté(e)
  • Auteur
Posté(e)
Il y a 11 heures, Olivier Eckmann a dit :

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)

 

Merci Olivier,

C'est exactement ca!

Merci infinement.

Nicky Apprentice

Nicky

Posté(e)
  • Auteur
Posté(e)
Il y a 11 heures, bonuscad a dit :

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)
        )
      )
    )
  )
)

 

Salut BonusCad,

Oui j'ai vu ta réponse sur Cadtutor et je t'en remercie.

Je n'ai pas encore eu le temps de tester ta routine mais je le ferai dès que possible.

A vrai dire, je cherchais à savoir si ma routine était corrigeable et si oui d'ou venait l'erreur.

Merci en tout cas

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité