Elevation Marker

By request from this thread:

http://www.cadtutor.net/forum/showthread.php?t=37199

I have created an Elevation Marker, using the same programming methods as used in the above thread.

;;;==========================[ MacElev.lsp ]=========================== 
;;; Author: Copyright© 2009 Lee McDonnell (Lee Mac)                     
;;;         (Contact @ CADTutor.net, The Swamp.org)                     
;;; Version:  1.0 June 13, 2009                                         
;;;           2.0 June 14, 2009                                         
;;;           3.0 June 16, 2009                                         
;;; Purpose: To Align an Elevation Marker to a Curve                    
;;; Sub_Routines: getpoint_or_text.lsp by Charles Alan Butler (CAB)     
;;;                                                                     
;;; Additional Features:                                                
;;; Use +/- to Alter Text Offset                                        
;;; Use "P" to toggle perpendicularity                                  
;;;==================================================================== 

(defun c:MacElev (/ *error* doc spc tmp tStr ent cObj
                    tObj gr cPt pt cAng lAng BsEl
                  
                   ; *Mac$Str*  }
                   ; *Mac$tOff* } Global Variables
                   ; *Mac$Per*  }

                  )
 (vl-load-com)

 ;; Error Handler

 (defun *error* (msg)
   (and tObj (not (vlax-erased-p tObj))
        (vla-delete tObj))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (princ))

 ;; Check for Locked Current Layer

 (if (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))

 ;; Get Space & Doc

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 ;; Set First-time Defaults
 
 (or *Mac$Str*  (setq *Mac$Str* "text"))
 (or *Mac$tOff* (setq *Mac$tOff* 1.))
 (or *Mac$Per*  (setq *Mac$Per* (/ pi 2.)))

 (if (setq bsEl (cadr (getpoint "\nSelect Base Elevation: ")))
   (progn

 ;; Get Text String
 
 (while (setq tmp
          (getpoint_or_text 2
            (strcat "\nSelect Level Curve or Specify Text <" *Mac$Str* ">: ")))
     (cond ((eq "" tmp))
           ((eq 'STR (type tmp))
            (setq *Mac$Str* tmp))
           ((vl-consp tmp)
            (setq cObj (vlax-ename->vla-object (car tmp))
                  *Mac$Str*
                   (rtos (- (cadr
                              (vlax-curve-getClosestPointto cObj
                                (cadr tmp))) bSEl)))))
     (setq tStr *Mac$Str*)
     (or tSze (setq tSze (getvar "TEXTSIZE")))

   ;; If No Curve Selected

   (if (not cObj)
        (while
          (progn
            (setq ent (nentsel "\nSelect Curve: "))
            (cond ((and (vl-consp ent)
                        (vl-position (cdr (assoc 0 (entget (car ent))))
                         '("LINE" "LWPOLYLINE" "POLYLINE" "ARC"
                           "SPLINE" "CIRCLE" "ELLIPSE" "XLINE")))
                   (setq cObj (vlax-ename->vla-object (car ent)))
                   nil) ; Exit Loop
                  (t (princ "\nMissed, Try Again...")))))) ; Keep in Loop

     ;; Create Text Object
     
       (vla-put-alignment
         (setq tObj
           (vla-addText spc tStr
             (vlax-3D-point '(0 0 0)) tSze)) acAlignmentMiddleCenter)

     ;; Place Text
           
     (while
       (or
         (and
           (setq gr (grread t 15 0))
             (eq (car gr) 5))
         (and
           (eq 2 (car gr)) ; Keyboard
           (vl-position (cadr gr)
             '(43 ; +
               45 ; -
               61 ; + (as =)
               80 112)))) ; P/p
       
       (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))
              (setq pt (vlax-curve-getClosestPointto cObj cPt)
                    cAng (angle pt cPt)
                    lAng (+ cAng *Mac$Per*))

              ;; Correct Angle
              
              (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                     (setq lAng (- lAng pi)))
                    ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                     (setq lAng (+ lAng pi))))
              
              (vla-move tObj
                (vla-get-TextAlignmentPoint tObj)
                  (vlax-3D-point
                    (polar pt cAng (* tSze *Mac$tOff*))))
              (vla-put-Rotation tObj lAng))

             ((eq 2 (car gr))
              (cond ((vl-position (cadr gr) '(43 61))
                     (setq *Mac$tOff*
                       (+ (/ tSze 10.) *Mac$tOff*)))
                    ((eq (cadr gr) 45)
                     (setq *Mac$tOff*
                       (-  *Mac$tOff* (/ tSze 10.))))
                    ((vl-position (cadr gr) '(80 112))
                     (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))))))))
   (princ "\n<< No BasePoint Specified >>"))
 (princ))

                      
;;;=======================[ getpoint_or_text.lsp ]======================= 
;;; Author: Copyright© 2005 Charles Alan Butler                           
;;;         (Slight Modification by Lee McDonnell)                        
;;; Version:  1.0 Dec. 12, 2005                                           
;;; Purpose: To get user entered text or picked point                     
;;; Sub_Routines: -None                                                   
;;; Requirements: -ctype is the cursor type                               
;;;                      0  Display the normal crosshairs.                
;;;                      1  Do not display a cursor (no crosshairs).      
;;;                      2  Display the object-selection "target" cursor  
;;;               -prmpt is the user prompt, start it with \n             
;;; Returns: - picked point or                                            
;;;            the user entered text or                                   
;;;            ""  for Enter Key                                          
;;;            nil for Escape Key                                         
;;;====================================================================== 
                      
(defun getpoint_or_text (ctype prmpt / char code data result flag p str)
 (vl-load-com)
 (vl-catch-all-apply
   '(lambda ()
      (setq flag t str "")
      (princ prmpt)
      (while flag
        (setq p    (grread t 15 ctype)
              code (car p)
              data (cadr p))
        (cond ((= code 3) ; clicked point

               ; {Modification}
               
               (if (and (setq result (nentselp data))
                        (vl-position (cdr (assoc 0 (entget (car result))))
                          '("LINE" "LWPOLYLINE" "POLYLINE" "ARC"
                            "SPLINE" "CIRCLE" "ELLIPSE" "XLINE")))
                 (setq flag nil)
                 (princ "\nMissed, Try Again...")))

              ; {End of Modification}
              
              ((= code 2) ; keyboard
               (setq char data)
               (cond ((<= 32 char 126)
                      (princ (chr char))
                      (setq str (strcat str (chr char))))
                     ((= char  ;; backspace was hit .. go chop off a character
                      (and (> (strlen str) 0)
                      (princ (strcat (chr  " " (chr ))
                      (setq str (substr str 1 (1- (strlen str))))))
                     ((= char 13)
                      (setq result str flag nil))))))))
 result)

;|
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;

                         End of Program Code

;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;
|;

Will try it in the morning. I can't get 2009 to stay stable with Windows 7 now. I am not sure what happened but it keeps fatal error anytime I select something.

Thanks Lee

Hmmm... coincidently, could be related to this thread...

http://www.cadtutor.net/forum/showthread.php?t=37278

I don't think so Lee. I am running the same at work (2009) and have had little trouble unless I am working with 25mb drawing or larger. We have 2010 but have not switched do to not knowing it if is better or the later. I see you are using 2010 now, what operating system are you using it with?

I see you are using 2010 now, what operating system are you using it with?

I am running Windows Vista Home Premium (SP2) - also, 2010 is the students version.