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

[thomas.steffenBJX2C]

Hi rgrainer,

  I am also a surveyor (survey tech/field crew) and trying to learn autoLISP. I admit I am just learning about this coding method but see the potential time saver. My hope is to do something similar in this thread with the Legend but I simply want to take all the blocks in my site limits and remove only the blocks that were selected from a legend that already has all possible blocks. I like having a legend that only shows the blocks that are present on the site. I don't expect you to give me the code, but I would really appreciate it if you could point me in the right direction for references that got you to where you are so that I might be able to learn how to write my own code. Any resources would be wonderful. I am currently looking into TheSwamp, Lee Mac and the AutoLISP developer manual.  

[rgrainer]

Check out this:
https://forum.dynamobim.com/t/the-civil-nodes-feedback-thread/105165 

and look at the post by @CodeDing  where he created a lisp named "legend" about 4th or 5th post

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-place-a-block-based-on-raw-d... 

Not sure about helping you out on your request to remove unused blocks from a master collection of all blocks. The options above are more direct

My advice is to go the Dynamo route. Lisp is good, but it can only do so much. But it is good to know the basics. If you get the hang of Dynamo you'll be better off in the long run.

[Sea-Haven]

Try this

; make legend
; May 2024 By AlanH

(defun RemoveDupes (InLst / OutLst CarElm)
  (while InLst
  (setq
    InLst (vl-remove (setq CarElm (car InLst)) (cdr InLst))
    OutLst (cons CarElm OutLst)
  )
  )
)

(defun makelegend ( /  ss lst lstrem obj pt pt2 ltname x val bname)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setvar 'textstyle "Standard")
(setq oldlay (getvar 'clayer))
(setvar 'clayer "0")

(setq ss (ssget "X" (list (cons 410 "Model"))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq lst (cons (list (vla-get-layer obj) (vlax-get obj 'Linetype)) lst))
)
(setq lst (RemoveDupes lst))
(setq lst (vl-sort lst '(lambda (x y) (<  (car x) (car  y)))))


(setq pt (getpoint "\nPick point for line legend "))
(setq pt2 (mapcar '+ pt (list 125.0 0.0 0.0)))

(foreach ltname lst
(command "line" pt (mapcar '+ pt (list 20.0 0.0 0.0)) "")
(command "chprop" (entlast) "" "LA" (car ltname) "LT" (cadr ltname) "S" 0.25 "")
(command "text" (mapcar '+ pt (list 25.0 0.0 0.0)) 2.5 0.0 (car ltname))
(setq pt (mapcar '+ pt (list 0.0 10.0 0.0)))
)

(setq lst '())
(setq attreq 0)

(repeat (setq x (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
  (if (= (vla-get-objectname obj) "AcDbBlockReference")
  (setq lst (cons (vla-get-name obj) lst))
  )
)
(setq lst (RemoveDupes lst))
(setq lst (vl-sort lst '(lambda (x y) (<  x  y))))

(foreach val lst
(if (wcmatch val "*U#*" )
(setq lst (vl-remove val lst))
)
)

(foreach bname lst
(progn
  (command "text" (mapcar '+ pt2 (list 25.0 0.0 0.0)) 2.5 0.0 bname)
  (command "-insert" bname pt2 1 1 0)
  (setq pt2 (mapcar '+ pt2 (list 0.0 10.0 0.0)))
  (setq obj (vlax-ename->vla-object (entlast)))
  (vla-GetBoundingBox obj 'minpoint 'maxpoint)
  (setq pointmin (vlax-safearray->list minpoint))
  (setq pointmax (vlax-safearray->list maxpoint))
  (setq ht (- (cadr pointmax)(cadr pointmin)))
  (setq xscale (/ 5.0  ht))
  (vla-put-xscalefactor obj xscale)
  (vla-put-yScaleFactor obj xscale)
)
)
 
(setvar 'osmode oldsnap)
(setvar 'clayer  oldlay)
(princ)
)
(makelegend)

[thomas.steffenBJX2C]

Thanks rgrainer,

  I appreciate you taking the time to respond to my request. I have quickly read through the other forums and they look like they will help me out alot. So thank you. I just need time to test it out. Been working in the field a lot lately so I haven't had time to try anything yet. 

[thomas.steffenBJX2C]

Thanks @Sea-Haven ,

  This code generated all the blocks in model space and surprisingly the linework even though there wasn't any in the model space. I am going to try and make some changes to the code on my own to hopefully get the blocks on the desired layers. Thank you for your code.

[Sea-Haven]

I will double check what is going on with linework should only be what is used. Wrote it a few years back and did not go back to it.