OK, I worked on the routine today and I think I've got code that's close to being finished (fingers crossed). CAB I just rearranged your code a little so that it made sense to me and added the portion that updates the block attribute. . . I wasn't quite sure why you pute the error-handling and exit routine at the beginning of the entire function, so I moved it out of the main function. I'd like to know if that was a bad idea.
Of course the code doesn't work. . . not sure why yet. Well, here it is:
;;; =================================================================
;;;---------------------------------------------------------------------;
;;; Anno.lsp
;;;
;;; Description: This function will input a block on a polyline. This block
;;; has a text field which will display the distance along the polyline from
;;; the start of the polyline. If the block is moved and placed on the polyline
;;; elsewhere, the text field will be automatically updated.
;;;
;;; Arguments: (none)
;;;
;;;
;;; Usage Anno
;;;
;;;---------------------------------------------------------------------;
(defun c:anno ()
(vl-load-com)
(Save_Sys '("CMDECHO" "OSMODE" ))
(setvar "cmdecho" 0)
(setvar "osmode" 547) ;; turn on end, int, mid, nea
;; ****************************************
;; Code starts here
;; ****************************************
(while (setq pt_ent (an:get_poly_pt))
(setq dist (an:get_dist pt_ent))
(command "insert" "ARV" (CADR pt_ent) "" "" "") ;; insert block ARV (no scaling/rotation)
(an:attribute dist) ;; update attribute NUM with dist
;; next line is a test ;; ??????????
;; (command "point" "non" (cadr pt_ent)) ;; ???NOT SURE WHY PUTTING POINT THERE???
;; End of main routine and exit
(*error* "") ;;(*error* "") ; call error routine to reset vars
(princ) ; exit quietly
) ; end while
) ; end defun
;;; =================================================================
;;; =================================================================
;; function to get a point along a polyline
;; returns a list of (ent_name, point) or
;; nil if user pressed ENTER
(defun an:get_poly_pt (/ loop ent)
(setvar "errno" 0) ; must pre set the errno to 0
(setq loop t)
(while loop
(cond
((and (null
(setq ent (entsel "\nPick a point on the pline to tag distance."))
)
(= (getvar "errno") 7) ; missed
)
(prompt "\nMissed, Try again.")
) ; end cond 1
((= (getvar "errno") 52) ; exit if user pressed ENTER
(setq loop nil) ; exit with nil
) ; end cond 2
((null ent)
(prompt "\nUnknown error, select again.")
) ; end cond 3
((= (cdr (assoc 0 (entget (car ent)))) "LWPOLYLINE")
(setq loop nil) ; exit with ent
) ; end cond 4
((= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
(setq loop nil) ; exit with ent
) ; end cond 5
(T
(prompt
(strcat "\nWrong object type: " (cdr (assoc 0 (entget (car ent)))))
)
) ; end cond 6
) ; end cond
) ; end while
ent ; return this
) ; end defun
;;; =================================================================
;;; =================================================================
;; function to return the distance of point from START.
;;
(defun an:get_dist (lst / obj)
(setq obj (vlax-ename->vla-object (car lst)))
(vlax-curve-getdistatpoint obj
(vlax-curve-getClosestPointTo obj (cadr lst)))
) ; end defun
;;; =================================================================
;;; =================================================================
;; function to update attribute NUM with distance along polyline
;;
(defun an:attribute (dist / prefix suffix station dist_round dist_len ename elist)
(setq prefix (an:round (fix (* dist 0.01)) )
suffix (progn
(setq dist_round (an:round dist)
dist_len (strlen dist_round)
) ;; end setq
(if (> dist_len 2) (substr dist_round (- dist_len 1) dist_len) dist_round)
) ; end progn
station (strcat prefix "+" suffix) ;; create attribute text
) ; end setq
(setq ename (entnext (entlast))
elist (entget ename))
;; search for attribute with tag = "NUM"
(while (and (= (cdr (assoc 0 elist))
"ATTRIB")
(/= (cdr (assoc 2 elist))
"NUM")
)
(setq ename (entnext ename) ;; try next attribute
elist (entget ename)
)
;; replace value with contents of variable 'dist'
(if (= (cdr (assoc 2 elist)) "NUM")
(progn
(entmod
(subst (cons 1 station) (assoc 1 elist) elist) ;; (new data, old data, list to use)
)
(entupd ename) ;; force regen of entity
;;station ;; DEBUG return text of attribute
)
;; else
(*error* "Attribute NUM not found in inserted block.")
) ; end if
) ; end while
) ; end defun
;;; =================================================================
;;; =================================================================
;; function to return real number as an integer string
;;
(defun an:round (num)
(rtos num 2 0)
) ; end defun
;;; =================================================================
;;; *****************************************************************
;; UTILITY FUNCTIONS
;;; *****************************************************************
;;; =================================================================
;; error function & Routine Exit
;;
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; endif
;;reset all variables here
(Restore_Sys)
) ;end error function
;;; =================================================================
;;; =================================================================
;; Function to save system variables
;; call to function
;; (Save_Sys '("CMDECHO" "BLIPMODE" "CLAYER" "OSMODE" "CELTYPE" "CECOLOR"))
;;
(defun Save_Sys (sysvar)
(setq *SysVar* '()) ; global var list of saved values
(repeat (length sysvar)
(setq *SysVar* (append *SysVar* (list (list (car sysvar) (getvar (car sysvar))))))
(setq sysvar (cdr sysvar))
)
)
;;; =================================================================
;;; =================================================================
;; Function to reset system variables
;;
(defun Restore_Sys ()
(and (listp *SysVar*)
(repeat (length *SysVar*)
(setvar (caar *SysVar*) (cadar *SysVar*)) ;set 1st item (system variable) as 2nd item in first list
(setq *SysVar* (cdr *SysVar*)) ; remove first list
)
)
)
;;; =================================================================
updates:
- changed \= to /=
- allow user to select POLYLINE as well as LWPOLYLINE
- (command "insert" "ARV" pt_ent "" "" "") changed to (command "insert" "ARV" (CADR pt_ent) "" "" "")
- took out modifications to correct alleged "rounding error"
- fixed error when clicking on polyline smaller shorter than 10 units
