Noob - Selection set problems

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

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

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

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

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

About 5 mins... its just practice

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, 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.

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>:

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

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.

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))
        

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....

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)))))

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!

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)))))

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))))))

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

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#)

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).

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