A LISP routine to create a block from selected objectes and scale it

[hmoreFPPR5]

I am trying to write a routine that lets the user select a set of objects. 
This set will be converted to a block with insertionpoint 0,0,0 and then scaled from basepoint 0,0,0 with a factor 0f 0.001. 
The usecase it to scale objects from millimetes to meters.

I found this code by Lee mac on a forum and i am trying to adapt it.

(defun c:obj2blk1 (/ ss bn pt i ent elist)

 ; Get Entities

   (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>"))))
   ) ;_  end while

 ; Get Block Name and Base Point

   (while (or (not bn)
          (not (snvalid bn))
      ) ;_  end or
   (setq bn (getstring "Specify Block Name: "))
   ) ;_  end while

   (initget 1)
   (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header
   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET
   (setq i (sslength ss))
   (while (>= i (setq i (1- i)) 0)
   (setq ent   (ssname ss i)
         elist (entget ent)
   ) ;_  end setq
   (entmake elist)
   ) ;_  end while

;;;FINISH THE BLOCK DEFINITION
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals
   (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
   (command "_.ERASE" ss "")
   (redraw)
   (prin1)
) ;_  end defun

It seems i am not able to alter the basepoint of the block from the variable pt to just a constant 0,0.

I am also not sure if it is possible to use the inserted block in a "scale" command after this script is completed.

[ВeekeeCZ · Accepted solution]

(defun c:obj2blk1 (/ ss bn pt i ent elist)

 ; Get Entities

   (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget))
   ) ;_  end while

 ; Get Block Name and Base Point

   (while (or (not bn)
          (not (snvalid bn))
      ) ;_  end or
   (setq bn (getstring "Specify Block Name: "))
   ) ;_  end while

;   (initget 1)
   (setq pt '(0 0)) ;(getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header
   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET
   (setq i (sslength ss))
   (while (>= i (setq i (1- i)) 0)
   (setq ent   (ssname ss i)
         elist (entget ent)
   ) ;_  end setq
   (entmake elist)
   ) ;_  end while

;;;FINISH THE BLOCK DEFINITION
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals
   (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt) '(41 . 0.001) '(42 . 0.001) '(43 . 0.001) ))
   (command "_.ERASE" ss "")
   (redraw)
   (prin1)
) ;_  end defun

[Kent1Cooper]

---

@hmoreFPPR5 wrote:

....

It seems i am not able to alter the basepoint of the block from the variable pt to just a constant 0,0.

I am also not sure if it is possible to use the inserted block in a "scale" command after this script is completed.

---

You don't really need the 'pt' variable in that case.  You should be able to remove it from the localized variables list, remove [or comment out] the line starting with

  (setq pt ...

and replace all instances of

  (cons 10 pt)

with

  '(10 0.0 0.0 0.0)

You can use "_last" or (entlast) for object selection in a Scale command, or you can assign the new scale factor to the Block by several other means [substituting in entity data, VLA properties, or the (setpropertyvalue) approach]. 

[hmoreFPPR5]

This worked perfectly, thank you!  I am very new to LISP and to AutoCAD in general. I am trying to learn more about using LISP routines to automate reoccurring tasks.  Its seems the reason my attempts at altering this script failed was due to a syntax error.

[hmoreFPPR5]

---

---

You don't really need the 'pt' variable in that case.  You should be able to remove it from the localized variables list, remove [or comment out] the line starting with

  (setq pt ...

and replace all instances of

  (cons 10 pt)

with

  '(10 0.0 0.0 0.0)

---

Using this gave me an error : 

; error: bad function: 10

---

You can use "_last" or (entlast) for object selection in a Scale command, or you can assign the new scale factor to the Block by several other means [substituting in entity data, VLA properties, or the (setpropertyvalue) approach]. 

---

This was really helpful, thank you! I was looking for a way to continue using the last entity in a couple of routines.

[ВeekeeCZ]

This is my routine doing basically the same thing... but using AutoCAD's commands, basic scripting. 

All you really need are the last two lines... The only little more complex thing is the autonaming.

Possibly good to learn from.

(defun c:BCreateAnonymous (/ *error* :getblockanonymname s p n)  ;ctrl+shift B
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'cmdecho 1)
    (princ))
  
  (defun :getblockanonymname ( / d r n)
    (while (setq d (tblnext "BLOCK" (null d)))
      (if (wcmatch (setq n (cdr (assoc 2 d))) "C$*")
	(setq r (cons n r))))
    (cond ((car (vl-sort r '>)))
	  ("C$1000")))
  
  (if (and (setq s (ssget))
	   (setq p (getpoint "\nBase point:"))
	   (setq n (:getblockanonymname))
	   (setq n (strcat "C$" (itoa (1+ (atoi (substr n 3))))))
	   (setvar 'cmdecho 0)
	   (princ (strcat "\nBlock created '" n " '"))
	   )
    (command "_.-BLOCK" n "_non" p s ""
	     "_.-INSERT" n "_s" 1 "_r" 0 "_non" p))
  (*error* "end")
  )

[Kent1Cooper]

---

@hmoreFPPR5 wrote:

---

---

.... replace all instances of

  (cons 10 pt)

with

  '(10 0.0 0.0 0.0)

---

Using this gave me an error : 

; error: bad function: 10

.....

---

Did you omit the apostrophe at the beginning?   That would cause such an error.