Label on contour line

HR2323 · ‎08-18-2015

Required lisp to Put labels on polyline edges, as shown in the sample drawing

Anonymous · ‎08-18-2015

It seems that all you require is to label the Z coordinate value.

There's several out there if you Google it

marlance · ‎08-18-2015

Hello

Check out this link below

label contour lisp

Polylines must have an elevation value.

HR2323 · ‎08-18-2015

It does not work well in this lisp code. The label displayed twice in close polyline. I should label one in close polyline.

(defun c:CLB (/ ss i ed p)
(vl-load-com)
(prompt "\nSelect Contour.. ")
(if (setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))
    (repeat (setq i (sslength ss))
      (setq ed (entget (ssname ss (setq i (1- i)))))
      (foreach x (list (car (setq p (vl-remove-if ''((x) (/= (car x) 10)) ed))) (last p))
   (entmakex (list   '(0 . "TEXT")'(8 . "CONTOUR LABEL")
           (cons 1 (rtos (cdr (assoc 38 ed)) 2 3))
           (cons 40 (getvar "textsize"))
           x
           ) ;_ end of list
          ) ;_ end of entmakex
   ) ;_ end of foreach
      ) ;_ end of repeat
    ) ;_ end of if
(princ)
) ;_ end of defun

ВeekeeCZ · ‎08-19-2015

Hi Sanju, try this code

(vl-load-com)
(defun c:ContoursLabel (/ ss i en p0 p1)

  (if (and (princ "\nSelect Contours, ")
	   (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
	   (not (command "_.-LAYER" "_N" "Contour_RL" "_C" 6 "" ""))
      )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
	    p0 (vlax-curve-getStartPoint en)
	    p1 (vlax-curve-getEndPoint en))
      (foreach x (if (equal p0 p1 )
		   (list p0)
		   (list p0 p1))
	(entmakex (list	'(0 . "TEXT")
			'(8 . "Contour_RL")
			(cons 1 (rtos (nth 2 x) 2 3))
			(cons 40 2)
			(cons 10 x))))))
  (princ)
)

HR2323 · ‎08-19-2015

BeekeeCZ,

Thank you very much for the code, last one more changes Text Rotation 45 degree.

ВeekeeCZ · ‎08-19-2015

You're welcome. Here it is.

Spoiler

(vl-load-com)

(defun c:ContoursLabel (/ ss i en p0 p1)
  
  (if (and (princ "\nSelect Contours, ")
	   (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
	   (not (if (tblobjname "LAYER" "Contour_RL")
		  nil
		  (command "_.-LAYER" "_N" "Contour_RL" "_C" 6 "" "")))
      )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
	    p0 (vlax-curve-getStartPoint en)
	    p1 (vlax-curve-getEndPoint en))
      (foreach x (if (equal p0 p1 )
		   (list p0)
		   (list p0 p1))
	(entmakex (list	'(0 . "TEXT")
			'(8 . "Contour_RL")
			(cons 1 (rtos (nth 2 x) 2 3))
			'(40 . 2)
			(cons 50 (/ pi 4))
			(cons 10 x))))))
  (princ)
)

(vl-load-com) (defun c:ContoursLabel (/ ss i en p0 p1) (if (and (princ "\nSelect Contours, ") (setq ss (ssget ":L" '((0 . "*POLYLINE")))) (not (if (tblobjname "LAYER" "Contour_RL") nil (command "_.-LAYER" "_N" "Contour_RL" "_C" 6 "" ""))) ) (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i))) p0 (vlax-curve-getStartPoint en) p1 (vlax-curve-getEndPoint en)) (foreach x (if (equal p0 p1 ) (list p0) (list p0 p1)) (entmakex (list '(0 . "TEXT") '(8 . "Contour_RL") (cons 1 (rtos (nth 2 x) 2 3)) '(40 . 2) (cons 50 (/ pi 4)) (cons 10 x)))))) (princ) )

_Tharwat · ‎08-19-2015

My version:

(defun c:Test (/ _t ss i sn st nd)
  ;; Tharwat 19.08.2015	;;
  (defun _t (p s)
    (entmake (append '((0 . "TEXT")
                       (8 . "Contour_RL")
                       (40 . 2.0)
                       (50 . 0.785398)
                       (7 . "Standard")
                       (71 . 0)
                       (72 . 0)
                       (73 . 0)
                       )
                     (list (cons 1 (rtos s 2 3))
                           (cons 10 p)
                           (cons 11 p)
                           )
                     )
             )
    )
  (princ "\nSelect Polylines :")
  (if (setq ss (ssget '((0 . "POLYLINE"))))
    (repeat (setq i (sslength ss))
      (setq sn (ssname ss (setq i (1- i)))
            st (vlax-curve-getstartpoint sn)
            nd (vlax-curve-getendpoint sn)
            )
      (if (vlax-curve-isclosed sn)
        (_t nd (caddr nd))
        (mapcar '_t
                (list st nd)
                (mapcar 'caddr (list st nd))
                )
        )
      )
    )
  (princ)
  )

My Website , Exchange Apps. Store.

ВeekeeCZ · ‎08-19-2015

Since I'm still not come to taste mapcar and lambda, so tell me what is your attitude better if not just different.

HR2323 · ‎08-19-2015

Thank you very much both of you for your cooperation. Specially thanks to BeekeeCZ .

_Tharwat · ‎08-19-2015

@ВeekeeCZ wrote:
Since I'm still not come to taste mapcar and lambda, so tell me what is your attitude better if not just different.

I am sorry BeekeeCZ , I did not mean any offense when I shared / posted my attempt in this thread .

I did not see you last codes because we posted almost at the same time and I saw a new reply from the OP asking about the rotation , I decided to post my that I wrote a few hours ago and I was outside the office and when I came back I posted the codes.

In regard to your question about the differences or about the use of mapcar & lambda , actually I just used mapcar when I THINK it is much more powerful than foreach function although there is no difference between the both of them in performance / outcome .

My Website , Exchange Apps. Store.

ВeekeeCZ · ‎08-19-2015

Sorry for my English if that sounded offensive... I really tried to avoid that... no hard feelings. Thanks for your experience with mapcar.

Anonymous · ‎06-04-2020

@ВeekeeCZ

@_Tharwat

Hi There!

First of all, I'm sorry my English is bad.

I really need help so much.

I saw your lisp here and I need help to change contour label interval 5, so the contour label will only show multiple by 5, it's like Elevation 110, 115, 120, 125.

Can you do a favor to help me?

or anybody else? Thank you so much.

(vl-load-com)
(defun c:ContoursLabel (/ ss i en p0 p1)

  (if (and (princ "\nSelect Contours, ")
	   (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
	   (not (command "_.-LAYER" "_N" "Contour_RL" "_C" 6 "" ""))
      )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
	    p0 (vlax-curve-getStartPoint en)
	    p1 (vlax-curve-getEndPoint en))
      (foreach x (if (equal p0 p1 )
		   (list p0)
		   (list p0 p1))
	(entmakex (list	'(0 . "TEXT")
			'(8 . "Contour_RL")
			(cons 1 (rtos (nth 2 x) 2 3))
			(cons 40 2)
			(cons 10 x))))))
  (princ)
)

Kent1Cooper · ‎06-05-2020

There are many rounding-off-to-the-nearest-multiple routines out there. Here's one way to do it:

Change

(cons 1 (rtos (nth 2 x) 2 3))

to

(cons 1 (itoa (* 5 (fix (/ (+ (nth 2 x) 2.5) 5.0)))))

Kent Cooper, AIA

ВeekeeCZ · ‎06-05-2020

This should do the trick.

(vl-load-com)
(defun c:ContoursLabel (/ ss i en p0 p1 int)
  
  (if (and (princ "\nSelect Contours, ")
	   (setq ss (ssget ":L" '((0 . "*POLYLINE"))))
	   (setq int (getint "\nSpecify interval: "))
	   (not (command "_.-LAYER" "_N" "Contour_RL" "_C" 6 "" ""))
	   )
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
	    p0 (vlax-curve-getStartPoint en)
	    p1 (vlax-curve-getEndPoint en))
      (if (equal (rem (last p0) int) 0 1e-6)
	(foreach x (if (equal p0 p1 )
		     (list p0)
		     (list p0 p1))
	  (entmakex (list '(0 . "TEXT")
			  '(8 . "Contour_RL")
			  (cons 1 (rtos (nth 2 x) 2 3))
			  (cons 40 2)
			  (cons 10 x)))))))
  (princ)
  )

Anonymous · ‎06-05-2020

@Kent1Cooper

@ВeekeeCZ

I really love how it works! but I forgot to say that I need "spacing" between label. Because that lisp too tight and close.

too tight & close

I'm sorry, I do not understand lisp at all. but this "script" help my works.

devitg · ‎06-05-2020

@Anonymous Please upload you sample.dwg , so the LISP could be fix to your need.

Anonymous · ‎06-05-2020

@devitg

@ВeekeeCZ

@Kent1Cooper

Okay, here sample.dwg that I want.

Interval 5

and the distance between labels not too close (Spacing)

Thank you all!

Kent1Cooper · ‎06-05-2020

@Anonymous wrote:

…. I need "spacing" between label. Because that lisp too tight and close. ….

I think what you need is:

1. A smaller text size;

2. To clean up the contours, eliminating gaps or breaks. The routine puts Text at the beginning and end of open-ended contours, or at the shared beginning/end of closed ones. Your crowded contours of the same value must be from gaps in the contours, where it's labeling both sides of each gap.

If it is not to put the Text at the beginning and end, then it would need you to tell it where to put the Text for each contour. That ruins the possibility of selecting multiple contours at once.

When the routine places a Text label, it doesn't know whether another contour in the selection will be "too close" to that later. And if somehow it keeps track of the location of every label, to avoid later ones being too close, there will be times when a label cannot be placed where it is clear to which contour it applies.

Kent Cooper, AIA

ВeekeeCZ · ‎06-06-2020

Best I can as of automation.

(vl-load-com)

(defun c:ContoursLabel (/ sel i ent int dst mxm pts)
  
  (if (and (princ "\nSelect Contours, ")
	   (setq sel (ssget ":L" '((0 . "*POLYLINE"))))
	   (setq int (getint "\nSpecify contour interval: "))
	   (setq dst (getint "\nSpecify spacing distance: "))
	   )
    (repeat (setq i (sslength sel))
      (setq ent (ssname sel (setq i (1- i))))
      (if (equal (rem (last (vlax-curve-getStartPoint ent)) int) 0 1e-6)
	(progn
	  (setq mxm (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
		len (* 0.5 (rem mxm dst)))
	  (while (< len mxm)
	    (setq pts (cons (cons (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtDist ent len)))
				  (vlax-curve-getPointAtDist ent len))
			    pts)
		  len (+ len dst)))))))
  (foreach pnt pts
    (entmakex (list '(0 . "TEXT")
		    (cons 1 (rtos (last pnt) 2 0))
		    (cons 40 2)
		    (cons 72 1)
		    (cons 73 2)
		    (cons 50 (car pnt))
		    (cons 10 (cdr pnt))
		    (cons 11 (cdr pnt)))))
  (princ)
  )

Community

Label on contour line

Label on contour line

Label on contour line