Move objects to match x (y,z)

Randolph · 发表于 2022-7-6 12:54:26

By the way - what does this mean:

"Seann: ...it went crazy ex-girlfriend on me..."

alanjt · 发表于 2022-7-6 12:57:56

It was part of some explanation Seann wrote out for a problem he was having. I could not stop laughing at his metaphor.

OK, how about this?

copy

(defun c:TZP (/ #SS #Pnt1 #Pnt2 #New) (cond   ((and (setq #SS (ssget "_:L"))         (setq #Pnt1 (getpoint "\nSpecify base point: "))         (setq #Pnt2 (getpoint "\nSpecify point for new Z value: "))    ) ;_ and    (setq #New  (vlax-3D-point (list (car #Pnt1) (cadr #Pnt1) (caddr #Pnt2)))          #Pnt1 (vlax-3D-point (list (car #Pnt1) (cadr #Pnt1) 0))    ) ;_ setq    (vlax-for x (setq                  #SS (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))                ) ;_ setq      (vla-move x #Pnt1 #New)    ) ;_ vlax-for    (vl-catch-all-apply 'vla-delete (list #SS))   ) ) ;_ cond (princ)) ;_ defun

Dirty command version:

copy

(defun c:TZP (/ #SS #Pnt1 #Pnt2) (and (setq #SS (ssget "_:L"))      (setq #Pnt1 (getpoint "\nSpecify base point: "))      (setq #Pnt2 (getpoint "\nSpecify point for Z value: "))      (command "_.move" #SS "" "_non" #Pnt1 ".Z" "_non" #Pnt2 "_non" #Pnt1) ) ;_ and (princ)) ;_ defun

Randolph · 发表于 2022-7-6 13:01:05

Yes, it's as perfect as it already was before, with the difference that you use the command tzp now. Might I see the code?

alanjt · 发表于 2022-7-6 13:05:40

Whoops, might help.

Something isn't quite right though.

alanjt · 发表于 2022-7-6 13:09:13

I went ahead and posted the original attempt, even thought it was WAAAY off.

http://www.cadtutor.net/forum/showpost.php?p=280023&postcount=3

alanjt · 发表于 2022-7-6 13:11:35

So......did it work?

Randolph · 发表于 2022-7-6 13:15:42

Yes, it works fine.

I just messed up my "Lisp to unload cui" functionality and overwrote my safety copy - what the hell --- must look for the thread ...

[编程交流] Move objects to match x (y,z)

发表回复

精选推荐