Lisp for Creating a Legend: Need Help with specifying spacing

[ISG-mpower]

Hello, 

I have a lisp routine which will create a legend of specified lines used in a drawing, but I need some help specifying the spacing between each line of text. I need a specific distance of 0.168 between each line of text. Here is the routine:

(defun C:LEGEND ( / *error* acdoc acobj an co e hs ht i la lst lt p p1 p2 p3 space ss st ro dr)
(vl-load-com)
(setq acObj (vlax-get-acad-object)
acDoc (vla-get-activedocument acObj)
space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
)
(vla-startundomark acDoc)

;;;;;; Error function ;;;;;;;;;
(defun *error* (msg)
(and
msg
(not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
(princ (strcat "\nError: " msg))
)
(if (and a (not (vlax-erased-p a))) (vla-delete a))
(vla-endundomark acDoc)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq st (entget (tblobjname "style" (getvar 'textstyle)) '("AcadAnnotative"))
an (member '(1070 . 1) (cdr (member '(1070 . 1) (cadr (assoc -3 st)))))
hs (cdr (assoc 40 st))
ro (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T)))
dr (trans '(0 0 1) 1 0 T)
)
(if
an
(setq ht (/ (if (> hs 0) hs 3.0) (cond ((getvar 'cannoscalevalue)) (1.0))))
(setq ht (* (if (> hs 0) hs 3.0) (getvar 'ltscale)))
)
(if
(setq ss (ssget))
(progn
(repeat (setq i (sslength ss))
(setq
e (entget (ssname ss (setq i (1- i))))
la (cdr (assoc 8 e))
lt (cdr (assoc 6 e))
co (cdr (assoc 62 e))
)
(if
(not (member (list la lt co) lst))
(setq lst (cons (list la lt co) lst))
)
)
(setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
(if
(setq p (getpoint "\nSpecify insert point: "))
(foreach x lst
(setq p1 (trans p 1 0)
p2 (trans (polar p 0.0 (* 10 ht)) 1 0)
p3 (trans (polar p 0.0 (* 11 ht)) 1 0)
)
(entmake
(list
'(0 . "LINE")
(cons 8 (car x))
(cons 10 p1)
(cons 11 p2)
(cons 6 (cond ((cadr x)) ("ByLayer")))
(cons 62 (cond ((caddr x)) (256)))
)
)
(vla-put-textalignmentpoint
(vlax-ename->vla-object
(entmakex
(list
'(0 . "TEXT")
(cons 8 (car x))
(cons 6 (cond ((cadr x)) ("ByLayer")))
(cons 62 (cond ((caddr x)) (256)))
'(100 . "AcDbText")
(list 10 0 0 0)
(cons 40 ht)
(cons 1 (car x))
(cons 50 ro)
(cons 7 (getvar 'textstyle))
(cons 72 0)
(list 10 0 0 0)
(cons 210 dr)
(cons 73 2)
)
)
)
(vlax-3d-point p3)
)
(setq p (polar p (/ pi -2.0) (* 2 ht)))
)
)
)
)
(*error* nil)
(princ)
)

[rgrainer]

http://www.lee-mac.com/blockcounter.html

try that

[Bryan-Kelley]

Hello Richard,

  Yes, I've seen that one.  But what we need is a routine that will take a copy of each and every block selected, or in the whole drawing, and place a copy in a single area within the drawing.

  The team in the panel shop need to make vinyl labels/stickers.  Since the blocks are already created and placed within the drawing file, they need a routine that will be able to take that existing data, copy it, and place it all in one location.

Thanks,

Bryan

[Bryan-Kelley]

Hi Alan,

  Thank you for the link.  I don't think it needs to go to that level of complexity.

Thanks,

Bryan

[rgrainer]

Took this from a @dlanorth function I found, tweaked it (minimally tested) and it will take a selection of blocks and copy them to one location. All blocks to one cluster point, it's not tiled so that the blocks are spaced the way you probably want them. That'll be up to you to figure out.

(defun rh:get_blks ( / ss)
  (prompt "\nSelect Blocks to cluster : ")
  (setq ss (ssget '((0 . "INSERT"))))
);end_defun

(defun c:b2cp ( / osm ss a_pt cnt ent i_pt)
  (setq osm (getvar 'osmode))
   (while (setq ss (rh:get_blks))
    (setvar 'osmode 64)
    (setq a_pt (getpoint "\nSelect Cluster Point : "))
    (repeat (setq cnt (sslength ss))
      (setq ent (ssname ss (setq cnt (1- cnt)))
            i_pt (cdr (assoc 10 (entget ent)))
      );end_setq
      (setvar 'osmode 0)
      (vl-cmdf "copy" ent "" i_pt a_pt)
      (setvar 'osmode 64)
    );end_repeat
    (setq ss nil)
    (gc)
  );end_while
  (setvar 'osmode osm)
  (princ)
);end_defun

[bharatvitkar]

In this lisp I have to replace line to created blocks by layer name