Noob - Selection set problems

[Lee Mac]

Sorry, I have no experience with visual lisp. Why does this benefit me?

 

If you are referring to my code, I have included the first IF statement to prevent an error if nothing is selected.

 

I have modified the "tracking point" section.

 

I have changed the way you filter the two selection sets.

 

The vla-move is 10x quicker than (command...

 

Lee

[bubba74]

Great, thanks Lee. I'm at Revision 1 right now. If all goes well, I will comment the code and look at improving.

[Lee Mac]

Great, thanks Lee. I'm at Revision 1 right now. If all goes well, I will comment the code and look at improving.

 

Not a problem, just adding my suggestions

[bubba74]

Your code is much more refined than mine. How long did it take you to write that? ;-)

[Lee Mac]

Your code is much more refined than mine. How long did it take you to write that? ;-)

 

About 5 mins... its just practice

[alanjt]

Here's an example I did that will mimic the COPY command (could be easily modified to MOVE). It uses the Express Tool acet-ss-move-drag subroutine to make things a little nicer. Its purpose was to return a selection set of the newly copied objects.

 

;;; Copy Command and return selectionset
;;; Requires Express Tools' ACET-SS-Drag-Move subroutine
;;; Alan J. Thompson, 11.09.09
(defun AT:Copy (/ #SS #Pnt1 #Pnt2 #Pnts #SSAdd #Copy)
 (cond
   ((and (setq #SS (ssget "_:L"))
         (setq #Pnt1 (getpoint "\nSpecify base point: "))
         (setq #Pnt2 (acet-ss-drag-move #SS #Pnt1 "\nSpecify placement point: " T))
    ) ;_ and
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Pnts (mapcar '(lambda (x) (vlax-3d-point (trans x 1 0)))
                        (list #Pnt1 #Pnt2)
                ) ;_ mapcar
    ) ;_ setq
    (setq #SSAdd (ssadd))
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (ssadd (vlax-vla-object->ename (setq #Copy (vla-copy x))) #SSAdd)
      (vla-move #Copy (car #Pnts) (cadr #Pnts))
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
   ) ;_ cond
 ) ;_ cond
 #SSAdd
) ;_ defun

Lee, I'm surprised you didn't suggest your version of acet-ss-drag-move.

[Lee Mac]

Lee, I'm surprised you didn't suggest your version of acet-ss-drag-move.

 

I didn't think it was necessary... The kti_archt_move does the moving, and the second selection set then has a known base pt and displacement vector.

 

Else, (command "_.move"... pause pause) was sufficient for the remaining selection set.

[alanjt]

I didn't think it was necessary... The kti_archt_move does the moving, and the second selection set then has a known base pt and displacement vector.

 

Else, (command "_.move"... pause pause) was sufficient for the remaining selection set.

 

 

I just don't like to use "move" ... pause pause. If the user right-clicks on either pause, it will use 0,0,0. At least it does on newer version. I'm not sure when they introduced it.

 

Command: m MOVE
Select objects: Specify opposite corner: 1 found

Select objects:

Specify base point or [Displacement] <Displacement>:

Specify displacement <0.00, 0.00, 0.00>:

[Lee Mac]

I understand, but this just seemed overkill in this situation...

[alanjt]

I understand, but this just seemed overkill in this situation...

 

I completely agree with you. I was only stating that I was surprised you didn't suggest it.

I will say, that if the user has access to acet-ss-drag-move, I suggest it over "move" ... pause pause any day.

[Lee Mac]

I suppose something like this then:

 

(defun acet-move (ss pt prmpt / v-move dpt)
 
 (defun v-move (ss p1 p2 / i ent)
   (vl-load-com) (setq i -1)
   (while (setq ent (ssname ss (setq i (1+ i))))
     (vla-move (vlax-ename->vla-object ent)
               (vlax-3D-point p1)
               (vlax-3D-point p2))) ss)

 (and (vl-catch-all-error-p
        (setq dpt
          (vl-catch-all-apply 'acet-ss-drag-move
            (list ss pt prmpt t 0))))
      (setq dpt pt))

 (v-move ss pt dpt))



(defun c:test (/ ss pt)

 (if (and (setq ss (ssget "_:L"))
          (setq pt (getpoint "\nBase Point: ")))
   (acet-move ss pt "\nMove Objects..."))

 (princ))
        

[LEsq]

Many moons ago wrote the below function, could be of a good use, never knows.

 

;; usage: (blk-drag-move "Specify second point of displacement: " new_obj)
;; block drag move
(defun blk-drag-move  (msg obj / take code5 p3)
 (prompt (strcat "\n"
   (cond (msg)
  ("Move"))
   "\n"))
 (while (and (setq take (grread 't 15)) (/= 3 (car take)))
   (setq code5 (car take)
  p3 (cadr take))
   (if (and p3 (= 5 code5))
     (vla-move
obj
(vla-get-insertionpoint obj)
(vlax-3d-point p3)))))

 

ps> to bad most of my lisp stuff it is gone....

[Lee Mac]

Luis, you could shrink that to this

 

;; usage: (blk-drag-move "Specify second point of displacement: " new_obj)
;; block drag move

(defun blk-drag-move  (msg obj / take code5 p3)
 (prompt (strcat "\n" (cond (msg) ("Move")) "\n"))
 (while (and (setq take (grread 't 15)) (/= 3 (car take)))
   (setq code5 (car take) p3 (cadr take))
   (if (and p3 (= 5 code5))
     (vla-put-insertionpoint obj (vlax-3d-point p3)))))

[LEsq]

Luis, you could shrink that to this

 

;; usage: (blk-drag-move "Specify second point of displacement: " new_obj)
;; block drag move

(defun blk-drag-move  (msg obj / take code5 p3)
 (prompt (strcat "\n" (cond (msg) ("Move")) "\n"))
 (while (and (setq take (grread 't 15)) (/= 3 (car take)))
   (setq code5 (car take) p3 (cadr take))
   (if (and p3 (= 5 code5))
     (vla-put-insertionpoint obj (vlax-3d-point p3)))))

 

Yep... the beauty of lisp... and about 12 years aprox. later...

 

Good!

[alanjt]

Yep... the beauty of lisp... and about 12 years aprox. later...

 

Good!

 

LoL

Come one Lee, you forgot to remove the (if statement. :wink:

 

    ([color=Red]if[/color] (and p3 (= 5 code5))
     (vla-put-insertionpoint obj (vlax-3d-point p3)))))

[Lee Mac]

haha

 

(defun blk-drag-move  (msg obj / take code5 p3)
 (prompt (strcat "\n" (cond (msg) ("Move")) "\n"))
 (while (and (setq take (grread 't 15)) (/= 3 (car take)))
   (and (= (car take) 5) (vla-put-insertionpoint obj (vlax-3d-point (cadr take))))))

 

[alanjt]

We are such nerds. LoL

 

(defun blk-drag-move (msg obj / take)
 (prompt (strcat "\n"
                 (cond (msg)
                       ("Move")
                 ) ;_ cond
                 "\n"
         ) ;_ strcat
 ) ;_ prompt
 (while (eq 5 (car (setq take (grread 't 15))))
   (vla-put-insertionpoint obj (vlax-3d-point (cadr take)))
 ) ;_ while
) ;_ defun

[LEsq]

haha

 

(defun blk-drag-move  (msg obj / take code5 p3)
 (prompt (strcat "\n" (cond (msg) ("Move")) "\n"))
 (while (and (setq take (grread 't 15)) (/= 3 (car take)))
   (and (= (car take) 5) (vla-put-insertionpoint obj (vlax-3d-point (cadr take))))))

 

 

Again the beauty of lisp...

 

I have so far in the project I am working on one of the classes 10,620 lines of code (C#)

[alanjt]

Again the beauty of lisp...

 

I have so far in the project I am working on one of the classes 10,620 lines of code (C#)

 

LoL

Do you even code in Lisp anymore Luis? I know you are a monster with C (based on what I've seen at theswamp).

[Lee Mac]

LoL

Do you even code in Lisp anymore Luis? I know you are a monster with C (based on what I've seen at theswamp).

 

I've seen some of your sigs on theSwamp Luis... saying how "mickey mouse" your LISP is lol

 

But yeah, your C is awesome