Change contour line layer according to altitude

[Nicky]

Hello everyone,

 

I have a small problem with the code below:

The routine allows by choosing an altitude multiple (0.5/1/2/5/10/25/50/100 meters) to place in a (new) layer the contour lines (located in an original layer) meeting the criterion.

 

However, recently, some curves are not placed in the new layer while the criterion is respected (the altitudes displayed in the properties are correct).

There may be an error in the code, or a variable to modify (precision or close rounding for example..)?

 

Thank you,

 

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

 

[Steven P]

Have you got an example drawing where this isnt working?

[Nicky]

HI Steven,

 

Of course. Here is an example. In this example 1, 5 and 25 feet does not work perfectly.

 

One more thing you should know:

Usually the files come from another application (Mensura) and are in meters. I transform them into feet using another scaling routine below...

 

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

 

Thanks.

Crooked Mile export mensura test.dwg

Edited 4 hours ago by Nicky

[BIGAL]

The obvious for me.

(setq elev (/ (* 9.164 1000.0) 0.3048)) = 30065.6167979003

 

With regard to round up/down do you want for say 0.5, 

30065.499999 = 30065.5 or 30065.0 or 30066.0 ie round up or down.

 

 

[Tsuky]

For try, this exemple?

(defun c:foo ( / ss l c n dxf_ent elev)
  (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 '(8 7 6 5 4 3 2 1)
      )
      (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
                  dxf_ent
                  (subst
                    (cons 8 (strcat "_NB-MajorLine_" (if (eq (car x) (fix (car x))) (rtos (car x) 2 0) (rtos (car x) 2 1))))
                    (assoc 8 dxf_ent)
                    dxf_ent
                  )
                )
                (entmod (append dxf_ent (list (cons 62 (cdr x)))))
              )
            )
          )
          (mapcar 'cons l c)
        )
      )
    )
  )
)