draw chainage on polyline

I've changed Station symbol to : Ch 2+200 m for ex. - it means 2200 m, but you can change "+" if you want to anything else, and if you don't want it just change it to "" - empty string... Also I've changed rotation of attribute to be opposite than initial - changed (/ pi 2) to (* pi 1.5) - in your red line : (vla-put-rotation at_obj (/ pi 9))... Also changed X,Y and Z scale factors of Station block during insertion to be : 5 5 5... Also changed text height of attribute from 1.5 to 1.0...

So here is mine version - little bit changed formatting of code, but it looks almost the same :

(defun div-error (msg)
 (if
   (vl-position
     msg
     '("console break"
       "Function cancelled"
       "quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (while (> (getvar "cmdactive") 0) (command))

 (setq *error* olderror)
 (princ)
)

(defun divplus (len segm / num lst)
 (setq num (fix (/ len segm)))
 (setq cnt 0)
 (while (<= cnt num)
   (setq tmp (* cnt segm))
   (setq lst (append lst (list tmp)))
   (setq cnt (1+ cnt))
 )
 (setq delta (- len (last lst)))
 (if (not (zerop delta))
   (setq lst (append lst (list (+ (last lst) delta))))
   lst
 )
)

(defun divminus (len segm / lst)
 (while (>= len 0.)
   (setq lst (append lst (list len)))
   (setq len (- len segm))
 )
 (if (not (zerop (last lst)))
   (setq lst (append lst (list 0.0)))
 )
 lst
)

(defun alg-ang (obj pnt)
 (angle '(0. 0. 0.)
        (vlax-curve-getfirstderiv
          obj
          (vlax-curve-getparamatpoint
            obj
            pnt
          )
        )
 )
)

(defun answer (quest / wshl ans)
 (or (vl-load-com))
 (setq wshl (vlax-get-or-create-object "WScript.Shell"))
 (setq ans (vlax-invoke-method
             wshl             'Popup           quest
             7                "Answer This Question:"
             vlax-vbYesNo
            )
 )
 (vlax-release-object wshl)
 (cond ((= ans 6)
        (setq opt T)
       )
       ((= ans 7)
        (setq opt nil)
       )
 )
 opt
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun make-station (bname    /        acsp     adoc     atprom
                    attag    at_obj   blk_obj  hgt      lay
                    line_obj sfar
                   )

 (vl-load-com)
 (setq adoc (vla-get-activedocument
              (vlax-get-acad-object)
            )
 )
 (if (and
       (= (getvar "tilemode") 0)
       (= (getvar "cvport") 1)
     )
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
 )
 (vla-startundomark adoc)

 (if (not (tblsearch "block" bname))
   (progn
     (setq attag  "NUMBER"             ;(strcase (getstring "\nAttribute tag : \n"))
           atprom "NUMBER"             ;(strcase (getstring T "\nAttribute prompt : \n"))
           hgt    1.0                  ;(getreal "\nAttribute text height : \n")
     )

     (setq lay (getvar "clayer"))
     (setvar "clayer" "0")
     (setvar "attreq" 0)

     (setq line_obj (vlax-invoke
                      acsp
                      'Addline
                      '(0. -3. 0.)
                      (list 0. (* hgt 2.) 0.)
                    )
     )
     (vla-put-color line_obj acred)
     (setq blk_obj (vla-add (vla-get-blocks adoc)
                            (vlax-3d-point '(0. 0. 0.))
                            bname
                   )
           sfar    (vlax-safearray-fill
                     (vlax-make-safearray vlax-vbObject '(0 . 0))
                     (list line_obj)
                   )
     )
     (vla-copyobjects adoc sfar blk_obj)
;;;  RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) 
     (setq at_obj (vla-addattribute
                    blk_obj
                    hgt
                    acattributemodeverify
                    atprom
                    (vlax-3d-point '(0 10. 0.))
                    attag
                    "0"
                  )
     )

     (vla-put-rotation at_obj (* pi 1.5))
     (vlax-release-object blk_obj)
   )
   (progn
     (princ "\n\t >> Block does already exist!\n")
     (princ)
   )
 )
 (if (tblsearch "block" bname)
   T
   (progn
     (alert "Impossible to add block")
   )
 )
 (setvar "attreq" 1)
 (setvar "clayer" lay)
 (vl-catch-all-apply
   (function (lambda () (vla-delete line_obj)))
 )
 (vla-regen adoc acactiveviewport)
 (vla-endundomark adoc)
 (vlax-release-object acsp)
 (vlax-release-object adoc)
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(or (vl-load-com))
(defun C:d10 (/        *error*  acsp     adoc     appd     div-error
             len      num      olderror pl       pt       pt_list
             step     util
            )

 (or adoc
     (setq adoc
            (vla-get-activedocument
              (vlax-get-acad-object)
            )
     )
 )
 (or appd (setq appd (vla-get-application adoc)))
 (or acsp
     (setq acsp
            (vla-get-block
              (vla-get-activelayout adoc)
            )
     )
 )
 (or util (setq util (vla-get-utility adoc)))

 (setq olderror *error*)
 (setq *error* div-error)

 (if (not (tblsearch "block" "Station"))
   (make-station "Station")
 )


 (vla-getentity
   util
   'pl
   'pt
   "\nSelect line NEAR OF POINT TO START measure: >>> \n"
 )
 (if pl
   (progn
     (setq step 100)
     (setq opt (answer "Rotate text perpendicularly to pline?"))
     (if (not step)
       (setq step 10.)
     )

     (setq len (vlax-curve-getdistatparam
                 pl
                 (vlax-curve-getendparam pl)
               )
     )

     (if (< (distance (vlax-safearray->list pt)
                      (vlax-curve-getstartpoint pl)
            )
            (distance (vlax-safearray->list pt)
                      (vlax-curve-getendpoint pl)
            )
         )
       (setq pt_list (divplus len step))
       (setq pt_list (divminus len step))
     )

     (setq
       pt_list (vl-remove-if
                 (function not)
                 (mapcar (function (lambda (x)
                                     (vlax-curve-getpointatdist pl x)
                                   )
                         )
                         pt_list
                 )
               )
     )

     (setq num 0)
     (mapcar
       (function
         (lambda (x / dr ang att_list at blk_obj)
           (progn

             (setq ang (alg-ang pl x)
                   ang
                       (cond ((< (/ pi 2) ang (* pi 1.5)) (+ pi ang))
                             (T ang)
                       )
             )
             (setq blk_obj (vlax-invoke
                             acsp     'Insertblock      x
                             "Station"         5        5
                             5        ang
                            )
             )
             (setq att_list (vlax-invoke blk_obj 'Getattributes))
             (foreach at att_list
               (if (eq (vlax-get at 'Tagstring) "NUMBER")
                 (progn
                   (vlax-put
                     at
                     'Textstring
                     (if (<= num 900.)
                       (strcat "Ch 0+" (if (equal num 0 1e-15) "000" (rtos num 2 0)) "m")
                       (strcat
                         "Ch "
                         (itoa (fix (/ num 1000.))) "+"
                         (if (equal (- num (* (fix (/ num 1000.)) 1000)) 0 1e-15) "000" (rtos (- num (* (fix (/ num 1000.)) 1000)) 2 0))
                         "m"
                       )
                     )
                   )
                   (if (not opt)
                     (vlax-put at 'Rotation 0)
                   )
                   (vla-update at)
                 )
               )
             )
             (vla-update blk_obj)
             (vlax-release-object blk_obj)
             (setq num (+ num step))
           )
         )
       )
       pt_list
     )

     (if (not (vlax-object-released-p pl))
       (vlax-release-object pl)
     )
   )
   (princ "\nNothing selected try again\n")
 )
 (vla-zoomextents appd)
 (vla-regen adoc acactiveviewport)
 (setq *error* olderror
       div-error nil
 )

 (princ)
)
(prompt "\n")
(prompt "\n    ***    Type D10 to execute    *** \n")
(princ)

Hope this helps...

M.R.

hi there.. i am a newbie when it comes to LISP..

can anyone tell me how do i start this LISP routine...??

I have already loaded this LSP in Autocad using "Appload" but now how do i start/invoke this script??

any help will be highly appreciated..

regards,

oops sorry my bad

*** Type D10 to execute ***

marko,

I just saw your response to this now. Sorry about that.

It works great now after I made the alterations you suggested for the chainage to display the way I want it.

A couple of things though:

Can it be setup not to rotate the chainage as it does currently on an arc? We choose one way and leave it run over the full length like that.

Another thing is the placing of a rounded chainage at the end of the line even though its not correct.

We also put a short green tick mark at 10m intervals. This doesn't have any text and is simply a block containing a line. But if I use the normal measure command it will place them to coincide with the 100m marks as well. Is there a way around this?

Thanks marko.

Fixo,

Are you able to help with this?

Thanks

I've done a little work on this routine, for running SEQ: stationing for underground fiber optic lines. Pretty easy to change "SEQ:" to "Sta:" in the routine. This equal distance is 25' on this one. See below.

(defun div-error (msg)
 (if
   (vl-position
     msg
     '("console break"
       "Function cancelled"
       "quit / exit abort"
      )
   )
    (princ "Error!")
    (princ msg)
 )
 (while (> (getvar "cmdactive") 0) (command))

 (setq *error* olderror)
 (princ)
)

(defun divplus (len segm / num lst)
 (setq num (fix (/ len segm)))
 (setq cnt 0)
 (while (<= cnt num)
   (setq tmp (* cnt segm))
   (setq lst (append lst (list tmp)))
   (setq cnt (1+ cnt))
 )
 (setq delta (- len (last lst)))
 (if (not (zerop delta))
   (setq lst (append lst (list (+ (last lst) delta))))
   lst
 )
)

(defun divminus (len segm / lst)
 (while (>= len 0.)
   (setq lst (append lst (list len)))
   (setq len (- len segm))
 )
 (if (not (zerop (last lst)))
   (setq lst (append lst (list 0.0)))
 )
 lst
)

(defun alg-ang (obj pnt)
 (angle '(0. 0. 0.)
        (vlax-curve-getfirstderiv
          obj
          (vlax-curve-getparamatpoint
            obj
            pnt
          )
        )
 )
)

(defun answer (quest / wshl ans)
 (or (vl-load-com))
 (setq wshl (vlax-get-or-create-object "WScript.Shell"))
 (setq ans (vlax-invoke-method
             wshl             'Popup           quest
             7                "Answer This Question:"
             vlax-vbYesNo
            )
 )
 (vlax-release-object wshl)
 (cond ((= ans 6)
        (setq opt T)
       )
       ((= ans 7)
        (setq opt nil)
       )
 )
 opt
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun make-station (bname    /        acsp     adoc     atprom
                    attag    at_obj   blk_obj  hgt      lay
                    line_obj sfar
                   )

 (vl-load-com)
 (setq adoc (vla-get-activedocument
              (vlax-get-acad-object)
            )
 )
 (if (and
       (= (getvar "tilemode") 0)
       (= (getvar "cvport") 1)
     )
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
 )
 (vla-startundomark adoc)

 (if (not (tblsearch "block" bname))
   (progn
     (setq attag  "NUMBER"             ;(strcase (getstring "\nAttribute tag : \n"))
           atprom "NUMBER"             ;(strcase (getstring T "\nAttribute prompt : \n"))
           hgt    1.0                  ;(getreal "\nAttribute text height : \n")
     )

     (setq lay (getvar "clayer"))
     (setvar "clayer" "0")
     (setvar "attreq" 0)

     (setq line_obj (vlax-invoke
                      acsp
                      'Addline
                      '(0. -3. 0.)
                      (list 0. (* hgt 2.) 0.)
                    )
     )
     (vla-put-color line_obj acred)
     (setq blk_obj (vla-add (vla-get-blocks adoc)
                            (vlax-3d-point '(0. 0. 0.))
                            bname
                   )
           sfar    (vlax-safearray-fill
                     (vlax-make-safearray vlax-vbObject '(0 . 0))
                     (list line_obj)
                   )
     )
     (vla-copyobjects adoc sfar blk_obj)
;;;  RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) 
     (setq at_obj (vla-addattribute
                    blk_obj
                    hgt
                    acattributemodeverify
                    atprom
                    (vlax-3d-point '(0 10. 0.))
                    attag
                    "0"
                  )
     )

     (vla-put-rotation at_obj (* pi 1.5))
     (vlax-release-object blk_obj)
   )
   (progn
     (princ "\n\t >> Block does already exist!\n")
     (princ)
   )
 )
 (if (tblsearch "block" bname)
   T
   (progn
     (alert "Impossible to add block")
   )
 )
 (setvar "attreq" 1)
 (setvar "clayer" lay)
 (vl-catch-all-apply
   (function (lambda () (vla-delete line_obj)))
 )
 (vla-regen adoc acactiveviewport)
 (vla-endundomark adoc)
 (vlax-release-object acsp)
 (vlax-release-object adoc)
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(or (vl-load-com))
(defun C:d10 (/        *error*  acsp     adoc     appd     div-error
             len      num      olderror pl       pt       pt_list
             step     util
            )

 (or adoc
     (setq adoc
            (vla-get-activedocument
              (vlax-get-acad-object)
            )
     )
 )
 (or appd (setq appd (vla-get-application adoc)))
 (or acsp
     (setq acsp
            (vla-get-block
              (vla-get-activelayout adoc)
            )
     )
 )
 (or util (setq util (vla-get-utility adoc)))

 (setq olderror *error*)
 (setq *error* div-error)

 (if (not (tblsearch "block" "Station"))
   (make-station "Station")
 )


 (vla-getentity
   util
   'pl
   'pt
   "\nSelect line NEAR OF POINT TO START measure: >>> \n"
 )
 (if pl
   (progn
     (setq step 25)
     (setq opt (answer "Rotate text perpendicularly to pline?"))
     (if (not step)
       (setq step 10.)
     )

     (setq len (vlax-curve-getdistatparam
                 pl
                 (vlax-curve-getendparam pl)
               )
     )

     (if (< (distance (vlax-safearray->list pt)
                      (vlax-curve-getstartpoint pl)
            )
            (distance (vlax-safearray->list pt)
                      (vlax-curve-getendpoint pl)
            )
         )
       (setq pt_list (divplus len step))
       (setq pt_list (divminus len step))
     )

     (setq
       pt_list (vl-remove-if
                 (function not)
                 (mapcar (function (lambda (x)
                                     (vlax-curve-getpointatdist pl x)
                                   )
                         )
                         pt_list
                 )
               )
     )

     (setq num 0)
     (mapcar
       (function
         (lambda (x / dr ang att_list at blk_obj)
           (progn

             (setq ang (alg-ang pl x)
                   ang
                       (cond ((< (/ pi 2) ang (* pi 1.5)) (+ pi ang))
                             (T ang)
                       )
             )
             (setq blk_obj (vlax-invoke
                             acsp     'Insertblock      x
                             "Station"         1        1
                             1        ang
                            )
             )
             (setq att_list (vlax-invoke blk_obj 'Getattributes))
             (foreach at att_list
               (if (eq (vlax-get at 'Tagstring) "NUMBER")
                 (progn
                   (vlax-put
                     at
                     'Textstring
                     (if (<= num 0.90)
                       (strcat "SEQ 0+" (if (equal num 0 1e-15) "00" (rtos num 2 0)) "")
                       (strcat
                         "SEQ: "
                         (itoa (fix (/ num 100.))) "+"
                         (if (equal (- num (* (fix (/ num 100.)) 100)) 0 1e-15) "00" (rtos (- num (* (fix (/ num 100.)) 100)) 2 0))
                         ""
                       )
                     )
                   )
                   (if (not opt)
                     (vlax-put at 'Rotation 0)
                   )
                   (vla-update at)
                 )
               )
             )
             (vla-update blk_obj)
             (vlax-release-object blk_obj)
             (setq num (+ num step))
           )
         )
       )
       pt_list
     )

     (if (not (vlax-object-released-p pl))
       (vlax-release-object pl)
     )
   )
   (princ "\nNothing selected try again\n")
 )
 (vla-zoomextents appd)
 (vla-regen adoc acactiveviewport)
 (setq *error* olderror
       div-error nil
 )

 (princ)
)
(prompt "\n")
(prompt "\n    ***    Type D10 to execute    *** \n")

(princ)

Hi all,

what would need to change in the code to have a pure run of numbers (without the decimal places) ?

eg. when it reaches 1000 the chainage currently goes to 1+0.00 ...... I am looking to display a simple 1000 and then 1010, 1020, 1030 and so on.

Thanks for any help.

Hi all,

what would need to change in the code to have a pure run of numbers (without the decimal places) ?

eg. when it reaches 1000 the chainage currently goes to 1+0.00 ...... I am looking to display a simple 1000 and then 1010, 1020, 1030 and so on.

 

Thanks for any help.

Try this:

(defun div-error (msg)
 (if (vl-position msg '("console break" "Function cancelled" "quit / exit abort"))
   (princ "Error!")
   (princ msg)
 )
 (while (> (getvar "cmdactive") 0) (command))
 (setq *error* olderror)
 (princ)
)

(defun divplus (len segm / num lst)
 (setq num (fix (/ len segm)))
 (setq cnt 0)
 (while (<= cnt num)
   (setq tmp (* cnt segm))
   (setq lst (append lst (list tmp)))
   (setq cnt (1+ cnt))
 )
 (setq delta (- len (last lst)))
 (if (not (zerop delta))
   (setq lst (append lst (list (+ (last lst) delta))))
   lst
 )
)

(defun divminus	(len segm / lst)
 (while (>= len 0.) (setq lst (append lst (list len))) (setq len (- len segm)))
 (if (not (zerop (last lst)))
   (setq lst (append lst (list 0.0)))
 )
 lst
)

(defun alg-ang (obj pnt)
 (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt)))
)

(defun answer (quest / wshl ans)
 (or (vl-load-com))
 (setq wshl (vlax-get-or-create-object "WScript.Shell"))
 (setq ans (vlax-invoke-method wshl 'popup quest 7 "Answer This Question:" vlax-vbyesno))
 (vlax-release-object wshl)
 (cond	((= ans 6) (setq opt t))
((= ans 7) (setq opt nil))
 )
 opt
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(defun make-station (bname / acsp adoc atprom attag at_obj blk_obj hgt lay line_obj sfar)
 (vl-load-com)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1))
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
 )
 (vla-startundomark adoc)
 (if (not (tblsearch "block" bname))
   (progn (setq attag	"NUMBER"	;(strcase (getstring "\nAttribute tag : \n"))
	 atprom	"NUMBER"	;(strcase (getstring T "\nAttribute prompt : \n"))
	 hgt	1.0		;(getreal "\nAttribute text height : \n")
   )
   (setq lay (getvar "clayer"))
   (setvar "clayer" "0")
   (setvar "attreq" 0)
   (setq line_obj (vlax-invoke acsp 'addline '(0. -3. 0.) (list 0. (* hgt 2.) 0.)))
   (vla-put-color line_obj acred)
   (setq blk_obj (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) bname)
	 sfar	 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list line_obj))
   )
   (vla-copyobjects adoc sfar blk_obj)
;;;  RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) 
   (setq at_obj	(vla-addattribute
		  blk_obj
		  hgt
		  acattributemodeverify
		  atprom
		  (vlax-3d-point '(0 10. 0.))
		  attag
		  "0"
		)
   )
   (vla-put-rotation at_obj (* pi 1.5))
   (vlax-release-object blk_obj)
   )
   (progn (princ "\n\t >> Block does already exist!\n") (princ))
 )
 (if (tblsearch "block" bname)
   t
   (progn (alert "Impossible to add block"))
 )
 (setvar "attreq" 1)
 (setvar "clayer" lay)
 (vl-catch-all-apply (function (lambda () (vla-delete line_obj))))
 (vla-regen adoc acactiveviewport)
 (vla-endundomark adoc)
 (vlax-release-object acsp)
 (vlax-release-object adoc)
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(or (vl-load-com))
(defun c:d10 (/ *error* acsp adoc appd div-error len num olderror pl pt pt_list step util)
 (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (or appd (setq appd (vla-get-application adoc)))
 (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
 (or util (setq util (vla-get-utility adoc)))
 (setq olderror *error*)
 (setq *error* div-error)
 (if (not (tblsearch "block" "Station"))
   (make-station "Station")
 )
 (vla-getentity util 'pl 'pt "\nSelect line NEAR OF POINT TO START measure: >>> \n")
 (if (and pl (or (setq step (getdist "\Enter step distance [<10>]: ")) (setq step 10)))
   (progn
     
     (setq opt (answer "Rotate text perpendicularly to pline?"))
     (if (not step)
(setq step 10.)
     )
     (setq len (vlax-curve-getdistatparam pl (vlax-curve-getendparam pl)))
     (if (< (distance (vlax-safearray->list pt) (vlax-curve-getstartpoint pl))
     (distance (vlax-safearray->list pt) (vlax-curve-getendpoint pl))
  )
(setq pt_list (divplus len step))
(setq pt_list (divminus len step))
     )
     (setq pt_list (vl-remove-if
	      (function not)
	      (mapcar (function (lambda (x) (vlax-curve-getpointatdist pl x))) pt_list)
	    )
     )
     (setq num 0)
     (mapcar
(function
  (lambda (x / dr ang att_list at blk_obj)
    (progn
      (setq ang	(alg-ang pl x)
	    ang	(cond ((< (/ pi 2) ang (* pi 1.5)) (+ pi ang))
		      (t ang)
		)
      )
      (setq blk_obj (vlax-invoke acsp 'insertblock x "Station" 1 1 1 ang))
      (setq att_list (vlax-invoke blk_obj 'getattributes))
      (foreach at att_list
	(if (eq (vlax-get at 'tagstring) "NUMBER")
	  (progn (vlax-put at 'textstring (strcat "SEQ " (rtos num 2 0)))
		 (if (not opt)
		   (vlax-put at 'rotation 0)
		 )
		 (vla-update at)
	  )
	)
      )
      (vla-update blk_obj)
      (vlax-release-object blk_obj)
      (setq num (+ num step))
    )
  )
)
pt_list
     )
     (if (not (vlax-object-released-p pl))
(vlax-release-object pl)
     )
   )
   (princ "\nNothing selected try again\n")
 )
 (vla-zoomextents appd)
 (vla-regen adoc acactiveviewport)
 (setq	*error*	olderror
div-error nil
 )
 (princ)
)
(prompt "\n")
(prompt "\n    ***    Type D10 to execute    *** \n")

You beauty

Excellent.

Thanks v much.

You beauty

Excellent.

Thanks v much.

You're welcome.