User moving objects within LISP

[Glen Smith]

I'm modifying a LISP that Lee wrote, What I want to do is iterate through a list of objects and have the user move each object depending on aesthetics.

 

Specifically, I have 100 door identification icons and want to zoom in on each one, decide if the icon needs to be moved a little, do the move if it does, and then go to the next icon.

 

(defun c:zmblk (/ file nl lst Minp Maxp pts elst BPNT DPNT)
 (vl-load-com)
 (if (setq file
       (getfiled "Select Text File"
         (if *load *load "") "txt" )

    (progn

     (setq *load file file (open file "r"))
     
     (while (setq nl (read-line file))
       (princ nl)
       (setq lst (cons (car (StrBrk nl 9)) lst)))
     (close file)
     (princ "\n<< Closed file >>")
     (if (setq elst (vl-remove-if 'null
                      (mapcar 'handent
                        (mapcar
                          (function
                            (lambda (x)
                              (substr x 2))) (reverse lst)))))
       (foreach Obj (mapcar 'vlax-ename->vla-object elst)                     
         (vla-getBoundingBox Obj 'Minp 'Maxp)
         (setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
         (vla-ZoomCenter
           (vlax-get-acad-object)
             (vlax-3D-point
               (polar (car pts)
                      (apply 'angle pts)
                      (/ (apply 'distance pts) 2.)))
           400.)
[color=Red]         (command "_MOVE"  Obj (SETQ BPNT (GETPOINT "\nPick base point: ")) (SETQ DPNT (GETPOINT "\nPick destination point: ")))
[/color]            )))

    (princ "\n<< No File Selected >>"))

  (princ))

(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

 

I need help with the actual moving of the object, Lee's code has already zoomed in on the object, so I think that I should be able to use that object and the move command, pick a base point and an destination point and go to the next object. But clearly I'm doing something wrong.

 

Thanks in advance,

Glen

[Lee Mac]

Completely untested, but should give you the idea.

 

I've also improved other parts of the code... not sure what I was thinking when I first wrote this...

 

(defun c:zmblk (/ file nl lst Minp Maxp pts elst BPNT DPNT)
 (vl-load-com)
 (setq *acad (vlax-get-acad-object))
 
 (if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
    (progn

     (setq *load file file (open file "r"))
     
     (while (setq nl (read-line file))
       (princ nl)
       (setq lst (cons (car (StrBrk nl 9)) lst)))
     (close file)      
     (princ "\n<< Closed file >>")
     
     (if (setq elst (vl-remove-if 'null
                      (mapcar 'handent
                        (mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
       
       (foreach Obj (mapcar 'vlax-ename->vla-object elst)                     
         (vla-getBoundingBox Obj 'Minp 'Maxp)
         
         (setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
         (vla-ZoomCenter *acad
           (vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)

         (initget "Yes No")
         (if (/= "No" (getkword "Move Object? <Yes> : "))
           (if (and (setq bPnt (getpoint "\nPick Base point: "))
                    (setq dPnt (getpoint bPnt "\nPick Destination: ")))
             (vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt))))))
         
    (princ "\n<< No File Selected >>"))

  (princ))

(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

[Glen Smith]

In the time it took me to close down and reboot AutoCAD because the LISP editor was locked up, Lee posted a solution for my problem. Many thanks.

 

I took the liberty of commenting out the "do you want to move it" question and discovered that simply hitting enter if you don't want to move the current object allows you to proceed to the next object. I also added the UNDO as a group code so I can undo all moves at once.

 

Updated code:

(defun c:zmblk (/ file nl lst Minp Maxp pts elst BPNT DPNT)
 (vl-load-com)
 (setq *acad (vlax-get-acad-object))
 
 (if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
    (progn

     (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
     (vla-startUndoMark doc)

     (setq *load file file (open file "r"))
     
     (while (setq nl (read-line file))
       (princ nl)
       (setq lst (cons (car (StrBrk nl 9)) lst)))
     (close file)      
     (princ "\n<< Closed file >>")
     
     (if (setq elst (vl-remove-if 'null
                      (mapcar 'handent
                        (mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
       
       (foreach Obj (mapcar 'vlax-ename->vla-object elst)                     
         (vla-getBoundingBox Obj 'Minp 'Maxp)
         
         (setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
         (vla-ZoomCenter *acad
           (vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)

;          (initget "Yes No")
;          (if (/= "No" (getkword "Move Object? <Yes> : "))
           (if (and (setq bPnt (getpoint "\nPick Base point: "))
                    (setq dPnt (getpoint bPnt "\nPick Destination: ")))
             (vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt)))))    <- extra paren had to go due to removing the 'prompt to move' if function
         
    (princ "\n<< No File Selected >>"))
  (vla-EndUndoMark doc)
  (princ))

(defun StrBrk (str chrc / pos lst)
 (while (setq pos (vl-string-position chrc str))
   (setq lst (cons (substr str 1 pos) lst)
         str (substr str (+ pos 2))))
 (reverse (cons str lst)))

So, Lee if I understand correctly, one reason my command didn't work is because (according to the help file) The vl-cmdf function mainly overcomes the limitation of not being able to use get.xxx functions inside command.

 

Glen

[Lee Mac]

You're welcome Glen

 

So, Lee if I understand correctly, one reason my command didn't work is because (according to the help file) The vl-cmdf function mainly overcomes the limitation of not being able to use get.xxx functions inside command.

 

Well, not quite.

 

I use vl-cmdf as it evaluates the arguments before proceeding and making changes. But that is not the reason your original didn't work.

 

Bear in mind that in the foreach loop, we are working with vla-objects, and not enames. The move command requires either a Selection Set or enames, so you had to convert the vla-object back to an ename

 

Lee

[Lee Mac]

Oh, one more thing -

 

I would put the EndUndoMark inside of the progn wrapper, as otherwise, if no file is selected the UndoMark's aren't paired. (Probably not such a big deal, but that just me).

 

Also, perhaps consider an error trap something like this;

 

(defun c:zmblk (/ *error* StrBrk *ACAD BPNT DOC DPNT ELST FILE
                                LST MAXP MINP NL OFILE PTS UFLAG)
 (vl-load-com)

[color=Red][b]  (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (and oFile (close oFile))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))[/b][/color]

 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))
 
 (if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
   (progn

     (setq doc   (vla-get-ActiveDocument (setq *acad (vlax-get-acad-object)))
           [color=Red][b]uflag[/b][/color] (not (vla-startUndoMark doc)))

     (setq *load file ofile (open file "r"))
     
     (while (setq nl (read-line ofile))
       (princ nl)
       (setq lst (cons (car (StrBrk nl 9)) lst)))
     [color=Red][b](setq ofile[/b][/color] (close ofile))
     
     (if (setq elst (vl-remove-if 'null
                      (mapcar 'handent
                        (mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
       
       (foreach Obj (mapcar 'vlax-ename->vla-object elst)                     
         (vla-getBoundingBox Obj 'Minp 'Maxp)
         
         (setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
         (vla-ZoomCenter *acad
           (vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)

           (if (and (setq bPnt (getpoint "\nPick Base point: "))
                    (setq dPnt (getpoint bPnt "\nPick Destination: ")))
             (vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt))))

     [b][color=Red](setq uflag[/color][/b] (vla-EndUndoMark doc)))
   
 (princ "\n<< No File Selected >>"))
 (princ))

 

 

Lee

[alanjt]

I have no way of testing this, but couldn't you just use vla-move?

 

 

(defun c:zmblk (/ *error* StrBrk _3dPoint *ACAD BPNT DOC DPNT ELST FILE
                                LST MAXP MINP NL OFILE PTS UFLAG)
 (vl-load-com)

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

 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))

 [color=Red](setq _3dPoint (lambda (x) (vlax-3d-point (trans x 1 0))))[/color]
 
 (if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
   (progn

     (setq doc   (vla-get-ActiveDocument (setq *acad (vlax-get-acad-object)))
           uflag (not (vla-startUndoMark doc)))

     (setq *load file ofile (open file "r"))
     
     (while (setq nl (read-line ofile))
       (princ nl)
       (setq lst (cons (car (StrBrk nl 9)) lst)))
     (setq ofile (close ofile))
     
     (if (setq elst (vl-remove-if 'null
                      (mapcar 'handent
                        (mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
       
       (foreach Obj (mapcar 'vlax-ename->vla-object elst)                     
         (vla-getBoundingBox Obj 'Minp 'Maxp)
         
         (setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
         (vla-ZoomCenter *acad
           (vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)

           (if (and (setq bPnt (getpoint "\nPick Base point: "))
                    (setq dPnt (getpoint bPnt "\nPick Destination: ")))
             ;;(vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt))))
             [color=Red](vl-catch-all-apply 'vla-move (list obj (_3dPoint bPnt) (_3dPoint dPnt))))))[/color]

     (setq uflag (vla-EndUndoMark doc)))
   
 (princ "\n<< No File Selected >>"))
 (princ))

[Lee Mac]

I have no way of testing this, but couldn't you just use vla-move?

 

Yup, I kinda had a bit of tunnel vision there....

[alanjt]

Yup, I kinda had a bit of tunnel vision there....

I do it all the time.

I wrote something the other day that was like 20-30 lines of code. As soon as I was finished, I looked at it, did a CTRL+A and Backspace and rewrote it in like 3 lines.

[Lee Mac]

I like your method though.. cheeky lambda function

[alanjt]

I like your method though.. cheeky lambda function

Thanks, just trying to cut down on typing.

[Lee Mac]

Thanks, just trying to cut down on typing.

 

Lucky we're in LISP... I've seen the reams and reams that the Arx guys produce....

[alanjt]

Lucky we're in LISP... I've seen the reams and reams that the Arx guys produce....

No kidding. A little daunting for a few guys trying to take the plunge from Lisp to C.

[Glen Smith]

I'm trying to further modify this code so that I can muck about with my dynamic blocks while inside the loop. I think what I need is a "wait here until I tell you to restart" command.

 

I tried using a pause, but that is only good for one "click event".

 

I tired (command pause pause pause) which lets me select the dynamic block, click the rotation grip and rotate to a new angle and then continue. But if I need to flip the block also, I'm outta luck.

 

Is there a way for a LISP to let the user do some selections, click around in the window and when done, hit a particular key which "restarts" (continues running) the LISP?

 

Glen

[Lee Mac]

For when a command is active, there is this:

 

(while (< 0 (getvar "CMDACTIVE"))
 (command pause))

[LEsq]

No kidding. A little daunting for a few guys trying to take the plunge from Lisp to C.

 

Tell me...

I still have some boxes with a lot of the stuff I wrote in lisp on my storage room....