Label - Create label with LISP

[Sambuddy]

Hey guys,

I am trying to create a label (see attached dwg) using lisp to;

upon entering the command:

1) ask for prefix then keep this prefix in memory (in this case BM-SC- let's say)

2) I would just enter the number associated with any block until i change my prefix

3) create a block with the criteria (dwg attached) and attributes so I can edit the text if need be

4) simply insert it on paperspace

5) also to auto adjust the box width so it remain a certain width but if it exceeds blah mm then to fit and center text within the maximum box size instead of extending the box.

I do not know where to begin or how to handle this.

Is it even possible with a lisp to accomplish all this?

I do have this as a dynamic block but it seems to be a redundant task after a dozen paste - I have to fit the text or adjust the box.

Thanks

 

label.dwg

[BIGAL]

Google text in box lisp, its out there.

[Sambuddy]

This is the extent I could succeed on the text insertion, numbering and prefix. Can anyone help me with creating a box and hatch for this label lisp please?

I did look at LEE MAC (BT) command but cannot seem to be able to combine the two + hatch the label.

and a general question: Can anyone in a few lines explain the ssget function and how to select entities that you create within the same lisp? It seems that I keep needing this function for my lisps but do not understand how it works!

Thanks

;; PROGRAM TO CREATE TXT LABEL					;;

(defun c:LBL ()
					; get first number 
  (setq prefix (getstring "\n Prefix <BM-PC->? "))
  (if (= prefix "")
    (setq prefix "BM-PC-")
  )
  (setq stnum (getint "\nStarting number? "))
  (setq label (strcat prefix " " (itoa stnum)))
  (setq incrnum 1)
  (setq placepoint (getpoint "\Select text location: "))
  (command "text" placepoint "2.381" "0" label)
  (setq stnum (+ stnum incrnum))
  (setq label (strcat prefix " " (itoa stnum)))
  (setq placepoint (getpoint "\Select text location: "))
  (while (/= placepoint nil)
    (command "text" placepoint "2.381" "0" label)
    (setq stnum (+ stnum incrnum))
    (setq label (strcat prefix " " (itoa stnum)))
    (setq placepoint (getpoint "\Select text location: "))
  )					;end while
  (princ)
)					; end defun

 

Lee Mac (BT) lisp:

;;-----------------------=={ Box Text }==---------------------;;
;;                                                            ;;
;;  Frames Text or MText objects with an LWPolyline, with     ;;
;;  optional offset. Works in all UCS/Views.                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.1    -    26-05-2013                            ;;
;;------------------------------------------------------------;;

(defun c:bt ( / *error* ent enx lst off )

    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (initget 4)
    (if (setq off (getreal (strcat "\nSpecify Offset Factor <" (rtos (cond (*off*) ((setq *off* 0.35))) 2 2) ">: ")))
        (setq *off* off)
        (setq off *off*)
    )
    
    (while
        (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Text or MText <Exit>: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'ename (type ent))
                    (if (setq lst (text-box (setq enx (entget ent)) (* off (cdr (assoc 40 enx)))))
                        (entmake
                            (append
                               '(
                                    (000 . "LWPOLYLINE")
                                    (100 . "AcDbEntity")
                                    (100 . "AcDbPolyline")
                                    (090 . 4)
                                    (070 . 1)
                                )
                                (list (cons 38 (caddar lst)))
                                (mapcar '(lambda ( x ) (cons 10 x)) lst)
                                (list (assoc 210 enx))
                            )
                        )
                        (princ "\nInvalid object selected.")
                    )
                )
            )
        )
    )
    (princ)
)

;; Text Box  -  gile / Lee Mac
;; Returns an OCS point list describing a rectangular frame surrounding
;; the supplied text or mtext entity with optional offset
;; enx - [lst] Text or MText DXF data list
;; off - [rea] offset (may be zero)

(defun text-box ( enx off / b h j l m n o p r w )
    (if
        (setq l
            (cond
                (   (= "TEXT" (cdr (assoc 0 enx)))
                    (setq b (cdr (assoc 10 enx))
                          r (cdr (assoc 50 enx))
                          l (textbox enx)
                    )
                    (list
                        (list (- (caar  l) off) (- (cadar  l) off))
                        (list (+ (caadr l) off) (- (cadar  l) off))
                        (list (+ (caadr l) off) (+ (cadadr l) off))
                        (list (- (caar  l) off) (+ (cadadr l) off))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 0 enx)))
                    (setq n (cdr (assoc 210 enx))
                          b (trans  (cdr (assoc 10 enx)) 0 n)
                          r (angle '(0.0 0.0 0.0) (trans (cdr (assoc 11 enx)) 0 n))
                          w (cdr (assoc 42 enx))
                          h (cdr (assoc 43 enx))
                          j (cdr (assoc 71 enx))
                          o (list
                                (cond
                                    ((member j '(2 5 8)) (/ w -2.0))
                                    ((member j '(3 6 9)) (- w))
                                    (0.0)
                                )
                                (cond
                                    ((member j '(1 2 3)) (- h))
                                    ((member j '(4 5 6)) (/ h -2.0))
                                    (0.0)
                                )
                            )
                    )
                    (list
                        (list (- (car o)   off) (- (cadr o)   off))
                        (list (+ (car o) w off) (- (cadr o)   off))
                        (list (+ (car o) w off) (+ (cadr o) h off))
                        (list (- (car o)   off) (+ (cadr o) h off))
                    )
                )
            )
        )
        (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) b)) l))
            (list
                (list (cos r) (sin (- r)) 0.0)
                (list (sin r) (cos r)     0.0)
               '(0.0 0.0 1.0)
            )
        )
    )
)
 
;; Matrix x Vector  -  Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
 
(defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(princ)

 

[BIGAL]

Use HELP inside Autocad look at lisp programming.

 

Just google ssget and look for \Autodesk in title for me it was the 1st entry.

 

Lee-mac has a excellent tutorial on some of the other ways of using ssget.

 

(ssget "selection method" "filters")

 

Section of code changed the clue was to look for the WHILE using Notepad++ found end of while and added the hatch at that point. Be careful if use solid white on white you will not see anything.

; Not tested note must set hatch pattern

(setvar 'hpname "SOLID")
(while
        (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Text or MText <Exit>: ")))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'ename (type ent))
                    (if (setq lst (text-box (setq enx (entget ent)) (* off (cdr (assoc 40 enx)))))
                        (entmake
                            (append
                               '(
                                    (000 . "LWPOLYLINE")
                                    (100 . "AcDbEntity")
                                    (100 . "AcDbPolyline")
                                    (090 . 4)
                                    (070 . 1)
                                )
                                (list (cons 38 (caddar lst)))
                                (mapcar '(lambda ( x ) (cons 10 x)) lst)
                                (list (assoc 210 enx))
                            )
                        )
                        (princ "\nInvalid object selected.")
                    )
                )
            )
        )
		(Command "hatch" "S" (entlast) "" "" "draworder" (entlast) "" "B")
    )
    (princ)
)

 

[Sambuddy]

thanks

I found another way to deal with my label issue - your instructions are too high tech at this point for me as I am dealing as I even have problems with elementary stuff sometimes.

 

[hanhphuc]

11 hours ago, Sambuddy said:

thanks

I found another way to deal with my label issue - your instructions are too high tech at this point for me as I am dealing as I even have problems with elementary stuff sometimes.

 

assumed you have ET installed

command: TCIRCLE

or (c:TCIRCLE)

[Sambuddy]

I wanted to make it more automated than once to add tags, once to use Tcircle, and anothertime to hatch the box. because of my stone age attempt on my codes after I posted my question, I did manage to accomplish all that (but I am ashamed of posting my code - it may look VERY dumb when some senior programmers look at it). But it has all worked out.

Thanks,

[BIGAL]

Dumb code I look at what I did 30 years ago it still works perfect.

 

This may be helpful rather than numbers does A-z 

 

 

Pt num bubble.lsp

Edited December 13, 2019 by BIGAL

[Sambuddy]

Thanks BIGAL. even when I am writing my codes today (after about 2 months being involved with LISP), I have so much trouble with ssget. It may be due me my negligence or lack of understanding the process - or simply do not know what I want at the time!

The other thing is, because I had such need to learn this program that I ignored the basics now the basics comes to bite me in the rear!

For example: Break between two executable is such a hard task for me - because I have no idea how to break, test, and continue... 

 

Thanks for your great help BIGAL

[Sambuddy]

@BIGAL

I wanted to take a peak at your "Bubble" lisp but it seems that I am missing "Multi Getvals.lsp". and it will not execute.

any tricks there: I noticed there is an IF condition there but still will not execute...

 

[BIGAL]

You can get Multi getvals and Multi Radio Buttons from the down load section here, its just me but I have gone to dcl's where more than 1 question is asked.

 

I was inspired by you VBA form with image and searching for answers for my Multigetvals image.lsp trying to replicate what you have done in the VBA. for others yes looking at Image tile and vector tile, opendcl for JPG.

Edited December 13, 2019 by BIGAL