Need label contour...

[fmn76]

hmmm... i hope somebody can help me... how to label contour for polyline with Z value...

[Alan Cullen]

Try this lisp routine....

;;-------------------------------------------------------------------------------
;; CONT_TXT.LSP   v1.0 MAY 1997             PLACE CONTOUR VALUE TEXT ON CONTOURS
;;===============================================================================
;; DESCRIPTION:  Routine to place contour value text on contours.
;;
;;               Routine works by getting the "ID" of a user selected point along
;;               a contour.  The "z" value of this point is then extracted and
;;               converted to a text string which is placed on the contour such
;;               that the midpoint of the text is the selected point.
;;
;;               Text orientation is from a second user supplied point.
;;
;;               The routine is set to snap to "nearest".
;;
;;               The Main Menu allows for selection of Existing surface contours,
;;               Finished surface contours, or exit from the routine.
;;
;; SETTINGS:     1.  Contours must hold the "z" value of their elevation.
;;               2.  "Units" setting must be 0 degrees to north, with angles
;;                   measured clockwise.
;;               3.  Previous drawing enviroment variables for "Colour", "Layer",
;;                   and "Snap mode" will be restored on exiting the routine.
;;               4.  Routine will exit with the text style set to "I" iso3098b.
;;               5.  Existing contour text is placed on a layer "conts ns", with
;;                   vertical text colour 1 (red) and size 1.8mm.
;;               6.  Finished contour text is placed on a layer "conts fs", with
;;                   sloping text colour 1 (red) and size 1.8mm.
;;               7.  The routine uses the dimensioning variable "Dimscale" to
;;                   adjust the text size to suit the intended drawing scale,
;;                   i.e.    dwg scale 1:1000   dimscale  1    text size  1.8
;;                                     1:500              0.5             0.9
;;                                     1:1500             1.5             2.7
;;
;; START COMMAND:    CT
;;
;; WRITTEN BY:       Alan Cullen - Cairns       May 1997
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;; ERROR HANDLER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun newerr (/ s)
 (if ocol (setvar "cecolor" ocol))
 (if olay (setvar "clayer" olay))
 (if ocmd (setvar "cmdecho" ocmd))
 (if olderr (setq *error* olderr))
 (if osnp (setvar "osmode" osnp))
 (setvar "textstyle" olstyle)
;; (command "style" "I" "ISO3098B" 0 1 0 "N" "N" "N")
 (if (/= s "Function cancelled")
  (if (= s "quit / exit abort")
   (princ)
   (princ (strcat "\nError: " s))
  )
  (princ "\n ERROR....CONSOLE BREAK....PREVIOUS DRAWING STATUS RESTORED          ")
 )
;; (setq ocmd nil olderr nil check nil secnam nil fil nil secure nil code nil
;;     olay nil ocol nil osnp nil pt1 nil rl nil ang nil lay nil opt nil opt1 nil ts nil)
 (print)
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;; PLACE TEXT ;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun place_txt ()
 (setq pt1 T)
 (while pt1
  (setq pt1 (getpoint "\n Pick mid point for text (snap set to nea).....<exit> : "))
  (if pt1
   (progn
    (setq rl (rtos (caddr pt1) 2 dec))  ;set number of decimal points - last figure in line.
    (setq ang nil)
    (setq ang (getangle pt1 "\n           Pick text orientation point (snap set to nea).....<exit> "))
    (if (not ang)
     (progn
      (setq pt1 nil)
     )
     (progn
      (setq ang (- (* 2 pi) ang))
      (setq ang (/ (* ang 180.0) pi))
      (command "text" "J" "M" pt1 ts ang rl)
 )))))
; (setq pt1 nil rl nil ang nil)
)
;;;;;;;;;;;;;;;;;;;;;;;;; MAIN PROGRAM ;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:ct ()
 (setq ocmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)                       ;;No commands echoed to screen
 (setq olderr *error* *error* newerr)       ;;Set new error handler
 (setq ocol (getvar "cecolor"))
 (setvar "cecolor" "1")
 (setq olay (getvar "clayer"))
 (setq olstyle (getvar "textstyle"))
 (setq osnp (getvar "osmode"))
 (setvar "osmode" 512)
 (setq ts (getvar "dimscale"))
 (setq ts (* ts 1.8))
 (setq opt T)
 (while opt
  (prompt "\n PLACE CONTOUR TEXT ON CONTOURS - MAIN MENU - May 1997 - Alan CULLEN")
  (print)
  (initget "Existing Finished Intdets Crap eXit")
  (setq opt1 (getkword "\n Select...........Existing / Finished / Intdets / Crap / eXit   (E/F/I/C/X) : "))
  (if opt1
   (cond
    ((= opt1 "Existing")
     (princ "\n EXISTING Surface Contours..............")
     (setq dec (getint "\n Enter number of decimal places... "))
     (print)
     (setq lay "ex conts")      ;set layer name for exist contour text.
     (if (= (tblsearch "layer" lay) nil)
      (command "LAYER" "make" lay "")
      (setvar "CLAYER" lay)
     )
     (if (= (tblsearch "style" "I" ) nil) (command "STYLE" "I"  "iso3098b" 0 1 0  "n" "n" "n"))
     (setvar "textstyle" "I")
     (place_txt)
;;     (setvar "textstyle" olstyle)
;;     (setvar "CLAYER" olay)
;;     (setq olay nil)
    )
    ((= opt1 "Finished")
     (princ "\n FINISHED Surface Contours..............")
     (setq dec (getint "\n Enter number of decimal places... "))
     (print)
     (setq lay "D CONTS FS")   ;set layer name for finished contour text.
;;     (setq lay "conts crap")
     (if (= (tblsearch "layer" lay) nil)
      (command "LAYER" "make" lay "")
      (setvar "CLAYER" lay)
     )
     (if (= (tblsearch "style" "IS") nil) (command "STYLE" "IS" "iso3098b" 0 1 20 "n" "n" "n"))
     (setvar "textstyle" "IS")
     (place_txt)
;;     (setvar "textstyle" olstyle)
;;     (setvar "CLAYER" olay)
;;     (setq olay nil)
    )
    ((= opt1 "Intdets")
     (princ "\n Intersection Detail Contours..............")
     (setq dec (getint "\n Enter number of decimal places... "))
     (print)
     (setq lay "D CONTS INTDETS")   ;set layer name for Intersection Detail contour text.
     (if (= (tblsearch "layer" lay) nil)
      (command "LAYER" "make" lay "")
      (setvar "CLAYER" lay)
     )
     (if (= (tblsearch "style" "IS") nil) (command "STYLE" "IS" "iso3098b" 0 1 20 "n" "n" "n"))
     (setvar "textstyle" "IS")
     (place_txt)
;;     (setvar "textstyle" olstyle)
;;     (setvar "CLAYER" olay)
;;     (setq olay nil)
    )
    ((= opt1 "Crap")
     (princ "\n Crap Contours..............")
     (setq dec (getint "\n Enter number of decimal places... "))
     (print)
     (setq lay "crap")   ;set layer name for Intersection Detail contour text.
     (if (= (tblsearch "layer" lay) nil)
      (command "LAYER" "make" lay "")
      (setvar "CLAYER" lay)
     )
     (if (= (tblsearch "style" "IS") nil) (command "STYLE" "IS" "iso3098b" 0 1 20 "n" "n" "n"))
     (setvar "textstyle" "IS")
     (place_txt)
;;     (setvar "textstyle" olstyle)
;;     (setvar "CLAYER" olay)
;;     (setq olay nil)
    )
    ((= opt1 "eXit")
     (setq opt nil opt1 nil)
 ))))
 (setvar "cecolor" ocol)
 (setvar "osmode" osnp)
 (setvar "clayer" olay)
 (setq *error* olderr)
 (setvar "cmdecho" ocmd)
 (setvar "textstyle" olstyle)
 (if (= (tblsearch "style" "I" ) nil) (command "STYLE" "I"  "iso3098b" 0 1 0  "n" "n" "n"))
; (setq ocmd nil olderr nil check nil secnam nil fil nil secure nil code nil
;       olay nil ocol nil osnp nil lay nil opt nil opt1 nil ts nil)
 (print)
 (princ "\n Routine exited normally by USER")
 (print)
 (princ)
)

[fmn76]

hmm... thank a lot... but im still with my problem with my lisp... cant solve

the this code...

(defun c:cpe (/ p val scl)
(command "wipeout" "f" "off")
(setq scl (getvar "dimscale"))
(setq om (getvar "osmode"))
(setvar "osmode" 512)
(setq p (getpoint "\nselect point on contour line: "))
(setq val (rtos (nth 2 p) 2 0))
(command "insert" "el_tag" p scl scl pause val)
(setvar "osmode" om)
(princ)
)

[CarlB]

What problem are you having when you run the routine? Error message?

[fmn76]

The value of label contour not coming out automaticly. So i must key-in the value directly. But the polyline have the Z value.

[ASMI]

It may not work by two reasons: Variable ATTREQ = 0 and block 'el_tag' not found in drawing database. I made some alterations to control this things, add loop for multiple labling and error catching function to correct variables restore.

(defun c:cpe (/ *error* scl om atq p val)

  (defun *error*(msg)
    (setvar "OSMODE" om)
    (setvar "ATTREQ" atq)
    (setvar "CMDECHO" 1)
    (princ)
    ); end of *error*
    
  (setvar "CMDECHO" 0)
  (command "_.wipeout" "_f" "off")
  (setq scl(getvar "DIMSCALE")
	om(getvar "OSMODE")
	atq(getvar "ATTREQ")); end setq
  (setvar "OSMODE" 512)
  (setvar "ATTREQ" 1)
  (if
    (tblsearch "BLOCK" "el_tag")
	  (while
	    (setq p(getpoint "\nSelect point on contour line or Esc to quit > "))
	      (setq val(rtos(last p)2 0))
	      (command "-insert" "el_tag" p scl scl pause val)
	    ); end while
    (princ "\n>>> Block 'el_tag' not found! <<< ")
    ); end if
  (setvar "OSMODE" om)
  (setvar "ATTREQ" atq)
  (setvar "CMDECHO" 1)
  (princ)
  ); end of c:cpe

[fmn76]

This my file...

[ASMI]

All work correctly with your file. Does my variant of c:cpe works? I thing reason in ATTREQ value.