Compose entities-blocks in a window and insert in drawing as a single entity

Is it possible to compose / put-together blocks, entities, text etc in a separate window (e.g. like the block editor) and then insert it as a single entity in the drawing ?

What I have in mind are the electrical outlet boxes in homes and apartments. These outlet boxes contain one, two or three switches / sockets etc and can be variable.

Have a look at this thread . I was planning to do as in this thread but I got stuck with creating a single entity. Maybe composing in a separate window might be a better idea.

A lead on how this could be done is welcome.

Thanks.

Creating a block from the objects is all I can think of at the moment, and this may help in that case:

(defun c:obj2blk (/ BNME ENT I PT SS SUB)
 ;; Lee Mac  ~  11.02.10

 (cond (  (not (setq ss (ssget '((0 . "~VIEWPORT"))))))

       (  (while
            (progn
              (setq bNme (getstring t "\nSpecify Block Name: "))

              (cond (  (not (snvalid bNme))
                       (princ "\n** Invalid Block Name **"))

                    (  (tblsearch "BLOCK" bNme)
                       (princ "\n** Block Already Exists **"))))))

       (  (not (setq i -1 pt (getpoint "\nSpecify Base Point: "))))

       (t (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bNme) (cons 70 0)))

          (while (setq ent (ssname ss (setq i (1+ i))))             
            (entmake (entget ent))
            
            (and (= 1 (cdr (assoc 66 (entget (setq sub ent)))))
                 (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq sub (entnext sub)))))))
                   (entmake (entget sub)))
                 (entmake (entget sub)))
            
            (entdel ent))

          (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))
          (entmake (list (cons 0 "INSERT") (cons 2 bNme) (cons 10 pt)))))

 (princ))

I hope you find time to look into the code below :

I tried to put together the box code and the obj2blk. I get strange results. When I launch the second time (the first time it works) it gets into a loop - I think.

(fools rush in where angles ..)

Besides I need to add "num" to the final block as an attribute.

(defun c:Bf (/ *error* LWPoly Text

                  ENT FLOOR GRP I LAY MA MI NNUM NUM
                  OFFSET POLY PTS SS THGT TOBJ UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  24.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 0.01  ;; Offset

       thgt 0.08   ;; Text Height

 )

 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun Line (pt1 pt2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 pt1)
                 (cons 11 pt2))))
   
 (defun LWPoly (lst cls)
   (entmakex (append (list (cons 0 "LWPOLYLINE")
                           (cons 100 "AcDbEntity")
                           (cons 100 "AcDbPolyline")
                           (cons 8 lay)
                           (cons 90 (length lst))
                           (cons 70 cls))
                     (mapcar (function (lambda (p) (cons 10 p))) lst))))

 (defun Text (pt hgt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 8 lay)
                   (cons 10  pt)
                   (cons 40 hgt)
                   (cons 1  str)
                   (cons 72 1)
                   (cons 73 2)
                   (cons 11 pt))))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))
 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
       
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))

     (setq Poly
       (LwPoly (list (list (- (car Mi) offset)
                           (- (cadr Mi) Offset) 0.)
                     (list (- (car Mi) offset)
                           (+ (cadr Ma) offset) 0.)
                     (list (+ (car Ma) offset)
                           (+ (cadr Ma) offset) 0.)
                     (list (+ (car Ma) offset)
                           (- (cadr Mi) offset) 0.)) 1))

     (setq num
              (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay))))
                 (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))

     (setq TObj
       (Text (list (/ (+ (car Mi) (car Ma)) 2.)
                   (- (cadr Mi) (+ Offset tHgt)) 0.) thgt num))

     (if (not (vl-catch-all-error-p
                (setq Grp
                  (vl-catch-all-apply
                    (function vla-Add)
                      (list (vla-get-Groups *doc) (strcat "BoxNumber_" num))))))
       
       (vla-AppendItems Grp
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbObject '(0 . 1))
             (mapcar
               (function vlax-ename->vla-object) (list Poly tObj)))))

       (princ (strcat "\n** Error Creating Group: "
                      (vl-catch-all-error-message Grp) " **")))
     
     (setq uFlag (vla-EndUndoMark *doc))))

(princ (strcat "\n the number is  :  " num))

 (setq x1 (- (car Mi) (* 2 offset)))
 (setq y1 (- (cadr Mi) (* 2 offset)))
 (setq x2 (+ (car Ma) (* 2 offset)))
 (setq y2 (- (cadr Ma) (* 2 offset)))
 (setq pt1 (list x1 y1))
 (setq pt2 (list x2 y2))
 (line pt1 pt2)
 


 (setq ss (ssget "W" pt1 pt2))
 (setq bNme "RH_") ; BLOCK IS ALWAYS REDEFINED

 (setq i -1)
 (entmake (list
        (cons 0 "BLOCK")
        (cons 10 pt1)
        (cons 2 bNme)
        (cons 70 0)))

 (while (setq ent (ssname ss (setq i (1+ i))))             
         (entmake (entget ent))
            
            (and (= 1 (cdr (assoc 66 (entget (setq sub ent)))))
                 (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq sub (entnext sub)))))))
                   (entmake (entget sub))
           ); WHILE
                 (entmake (entget sub))
           );AND
            
            (entdel ent)
   );WHILE

          (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))
          (entmake (list (cons 0 "INSERT") (cons 2 bNme) (cons 10 pt1)))


 (princ))

I went about it another way - using the Visual LISP method for creating a block, slightly easier in this instance.

Note: another control added to the top:

(defun c:BoxObj (/ *error* BLK DEL ENT FLOOR I LAY MA MI NNUM NUM OBJLST OFFSET PTS SPC SS THGT UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt 2.5   ;; Text Height

       del  t     ;; Delete Original Objects

 )

 
 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))


 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       spc  (if (or (eq AcModelSpace (vla-get-ActiveSpace *doc))
                    (eq :vlax-true   (vla-get-MSpace *doc)))
              (vla-get-ModelSpace *doc)
              (vla-get-PaperSpace *doc)))

 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))

     (or (tblsearch "LAYER" lay)
         (vla-add (vla-get-Layers *doc) lay))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))

       (setq Objlst (cons obj Objlst))
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))
     

     (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset)
                                                             (- (cadr Mi) Offset) 0.) "*U"))

     (vla-copyObjects *doc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbObject
             (cons 0  (1- (length ObjLst))))
           ObjLst))
       Blk)
     

     (vla-put-closed
       (vlax-invoke blk 'AddLightWeightPolyline
         (list (- (car Mi) offset)
               (- (cadr Mi) Offset)
               (- (car Mi) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (- (cadr Mi) offset)))  :vlax-true)
     

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent)))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))
     

     (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num"
       (list (/ (+ (car Mi) (car Ma)) 2.)
             (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num)
     

     (vla-put-layer
       (vlax-invoke spc 'InsertBlock (list (- (car Mi) offset)
                                           (- (cadr Mi) Offset) 0.)
         (vla-get-Name blk) 1. 1. 1. 0.)

       lay)
     

     (if Del (mapcar (function vla-delete) ObjLst))
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

That was really great. Just as i wanted.

Thanks a lot.

(.. and where would the easy part be ?)

That was really great. Just as i wanted.

 

Thanks a lot.

You're welcome Sadhu

(.. and where would the easy part be ?)

Well, it was easier than messing with DXF tables anyway I made the code create anonymous blocks, as I thought this might be better.

Here I'm again with another request.

Can you please add rotate/move/scale feature to your code ?

or maybe just a lead.

Thanks.

I'm not sure I understand - why not just move/scale/rotate the block after its creation?

It is to reduce the number of clicks and increase efficiency.

Each apartment has about 50 blocks to insert. Often, depending on the client, there are between 20-50 apartments in a construction site. And this goes on the whole year round.

So you can imagine how tiring it is.

True, but surely each situation would differ - how would you code all that into the program?

Actually I was trying with this :

(and
 (setq Pts (acet-ss-drag-move (ssadd blk) Pt1 "\nSpecify Second Point: " t 0))
    (not (vla-move (vlax-ename->vla-object blk)
              (vlax-3D-point Pts)
              (vlax-3D-point Pt2)))
    (setq Rot (acet-ss-drag-rotate (ssadd blk) Pt2 "Specify angle: " T 0))
    (vla-put-rotation (vlax-ename->vla-object blk) Rot))

but didn't get any result. Infact "blk" returned nil. I was hoping to get the last block inserted. Each block is created (composed) and inserted one at a time.

That's because 'blk' is the block definition as found in the Document Block table, not the reference object.

I'll post an example in a bit

(defun c:BoxObj (/ *error*

                  BENT BLK BOBJ DEL ENT FLOOR I LAY MA MI NNUM NUM
                  OBJLST OFFSET P1 P2 PTS R SPC SS THGT UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt 2.5   ;; Text Height

       del  t     ;; Delete Original Objects

 )

 
 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))


 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       spc  (if (or (eq AcModelSpace (vla-get-ActiveSpace *doc))
                    (eq :vlax-true   (vla-get-MSpace *doc)))
              (vla-get-ModelSpace *doc)
              (vla-get-PaperSpace *doc)))

 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))

     (or (tblsearch "LAYER" lay)
         (vla-add (vla-get-Layers *doc) lay))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))

       (setq Objlst (cons obj Objlst))
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))
     

     (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset)
                                                             (- (cadr Mi) Offset) 0.) "*U"))

     (vla-copyObjects *doc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbObject
             (cons 0  (1- (length ObjLst))))
           ObjLst))
       Blk)
     

     (vla-put-closed
       (vlax-invoke blk 'AddLightWeightPolyline
         (list (- (car Mi) offset)
               (- (cadr Mi) Offset)
               (- (car Mi) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (- (cadr Mi) offset)))  :vlax-true)
     

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent)))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))
     

     (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num"
       (list (/ (+ (car Mi) (car Ma)) 2.)
             (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num)
     

     (vla-put-layer
       (setq bObj
         (vlax-invoke spc 'InsertBlock (setq p1 (list (- (car Mi)  offset)
                                                      (- (cadr Mi) Offset) 0.))
           (vla-get-Name blk) 1. 1. 1. 0.))

       lay)
     

     (if Del (mapcar (function vla-delete) ObjLst))

     (and (setq p2 (acet-ss-drag-move
                     (ssadd (setq bEnt (vlax-vla-object->ename bObj)))
                     p1 "\nSpecify Second Point: " t 0))
          
          (not (vla-move bObj (vlax-3D-point p1) (vlax-3D-point p2)))
          (setq r  (acet-ss-drag-rotate (ssadd bEnt) p2 "\nSpecify Angle: " t 0))
          (vla-put-rotation bObj r))                          
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

Just tried it. Thanks. It works.

You are indeed a luminous being.

Thanks Sadhu,

With a Scale option also:

(defun c:BoxObj (/ *error*

                  BENT BLK BOBJ DEL ENT FLOOR I LAY MA MI NNUM NUM
                  OBJLST OFFSET P1 P2 PTS R SPC SS THGT UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt 2.5   ;; Text Height

       del  t     ;; Delete Original Objects

 )

 
 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))


 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       spc  (if (or (eq AcModelSpace (vla-get-ActiveSpace *doc))
                    (eq :vlax-true   (vla-get-MSpace *doc)))
              (vla-get-ModelSpace *doc)
              (vla-get-PaperSpace *doc)))

 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))

     (or (tblsearch "LAYER" lay)
         (vla-add (vla-get-Layers *doc) lay))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))

       (setq Objlst (cons obj Objlst))
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))
     

     (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset)
                                                             (- (cadr Mi) Offset) 0.) "*U"))

     (vla-copyObjects *doc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbObject
             (cons 0  (1- (length ObjLst))))
           ObjLst))
       Blk)
     

     (vla-put-closed
       (vlax-invoke blk 'AddLightWeightPolyline
         (list (- (car Mi) offset)
               (- (cadr Mi) Offset)
               (- (car Mi) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (- (cadr Mi) offset)))  :vlax-true)
     

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent)))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))
     

     (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num"
       (list (/ (+ (car Mi) (car Ma)) 2.)
             (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num)
     

     (vla-put-layer
       (setq bObj
         (vlax-invoke spc 'InsertBlock (setq p1 (list (- (car Mi)  offset)
                                                      (- (cadr Mi) Offset) 0.))
           (vla-get-Name blk) 1. 1. 1. 0.))

       lay)
     

     (if Del (mapcar (function vla-delete) ObjLst))

     (and (setq p2 (acet-ss-drag-move
                     (ssadd (setq bEnt (vlax-vla-object->ename bObj)))
                     p1 "\nSpecify Second Point: " t 0))
          
          (not (vla-move bObj (vlax-3D-point p1) (vlax-3D-point p2)))
          (setq s  (acet-ss-drag-scale  (ssadd bEnt) p2 "\nSpecify Scale: " t 0))
          (mapcar
            (function
              (lambda (prop)
                (vlax-put-property bObj (read (strcat prop "ScaleFactor")) s))) '("X" "Y" "Z"))
          (setq r  (acet-ss-drag-rotate (ssadd bEnt) p2 "\nSpecify Angle: " t 0))
          (vla-put-rotation bObj r))                          
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

Thanks. This is too good.

Is it possible to put the scale option as the last action ?

Thanks again.

Certainly, just swicth the segments of code around

(defun c:BoxObj (/ *error*

                  BENT BLK BOBJ DEL ENT FLOOR I LAY MA MI NNUM NUM
                  OBJLST OFFSET P1 P2 PTS R SPC SS THGT UFLAG)
 
 (vl-load-com) ;; Lee Mac  ~  11.02.10

 (setq lay "My Boxing Layer" ;; Layer

       offset 5.  ;; Offset

       thgt 2.5   ;; Text Height

       del  t     ;; Delete Original Objects

 )

 
 (defun *error* (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))


 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))

       spc  (if (or (eq AcModelSpace (vla-get-ActiveSpace *doc))
                    (eq :vlax-true   (vla-get-MSpace *doc)))
              (vla-get-ModelSpace *doc)
              (vla-get-PaperSpace *doc)))

 
 (if (setq ss (ssget))
   (progn
     (setq uFlag (not (vla-StartUndoMark *doc)))

     (or (tblsearch "LAYER" lay)
         (vla-add (vla-get-Layers *doc) lay))
     
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))

       (setq Objlst (cons obj Objlst))
       (vla-getBoundingbox obj 'Mi 'Ma)
       (setq pts (cons (vlax-safearray->list Mi)
                       (cons (vlax-safearray->list Ma) pts))))
     (vla-delete ss)
     
     (setq Mi (apply (function mapcar) (cons 'min pts))
           Ma (apply (function mapcar) (cons 'max pts)))
     

     (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset)
                                                             (- (cadr Mi) Offset) 0.) "*U"))

     (vla-copyObjects *doc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbObject
             (cons 0  (1- (length ObjLst))))
           ObjLst))
       Blk)
     

     (vla-put-closed
       (vlax-invoke blk 'AddLightWeightPolyline
         (list (- (car Mi) offset)
               (- (cadr Mi) Offset)
               (- (car Mi) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (+ (cadr Ma) offset)
               (+ (car Ma) offset)
               (- (cadr Mi) offset)))  :vlax-true)
     

     (setq num
       (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1))))
         (progn
           (while (setq ent (ssname ss (setq i (1+ i))))
             (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent)))))))
               (setq floor nNum)))

           (itoa (1+ floor))) "1"))
     

     (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num"
       (list (/ (+ (car Mi) (car Ma)) 2.)
             (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num)
     

     (vla-put-layer
       (setq bObj
         (vlax-invoke spc 'InsertBlock (setq p1 (list (- (car Mi)  offset)
                                                      (- (cadr Mi) Offset) 0.))
           (vla-get-Name blk) 1. 1. 1. 0.))

       lay)
     

     (if Del (mapcar (function vla-delete) ObjLst))

     (and (setq p2 (acet-ss-drag-move
                     (ssadd (setq bEnt (vlax-vla-object->ename bObj)))
                     p1 "\nSpecify Second Point: " t 0))
          
          (not (vla-move bObj (vlax-3D-point p1) (vlax-3D-point p2)))
          (setq r  (acet-ss-drag-rotate (ssadd bEnt) p2 "\nSpecify Angle: " t 0))
          (vla-put-rotation bObj r)
          (setq s  (acet-ss-drag-scale  (ssadd bEnt) p2 "\nSpecify Scale: " t 0))
          (mapcar
            (function
              (lambda (prop)
                (vlax-put-property bObj (read (strcat prop "ScaleFactor")) s))) '("X" "Y" "Z")))                          
     
     (setq uFlag (vla-EndUndoMark *doc))))      

 (princ))

Thanks, Lee. You are great.

(just forgot to post a reply earlier)