[编程交流] 移动宏

;
;   prompt for input
;
(setq dist(getdist"\nEnter the distance to move: "))
(setq angl(getreal"\nEnter the angle: "))
(setq obj(getreal"\npick the object you want moved: "))
;
;
;
(setq xvalue(     (cos angl)*dist    )
(setq yvalue(     (sin angl)*dist    )
;
(COMMAND "move"  obj 0,0 @xvalue,yvalue "")

; mvm.lsp - move selected objects to a specified distance at an angle
;           and color them green
(defun dtr (a) ;Degrees to radians conversion
(* pi (/ a 180.0))
)
(defun c:mvm (/ dis angl objset n en el bse vec)
(setq dis (getdist"\n Enter the distance to move: "))
(setq angl (getreal"\n Enter the angle: "))
(princ "\n Pick the object(s) you want moved: ")
(setq objset (ssget))
(setq n (- (sslength objset) 1))
(while (> n -1) ; make the moved objects green
(setq en (ssname objset n))
(setq el (entget en))
(setq el (subst (cons 62 3) (assoc 62 el) el))
(entmod el)
(setq n (- n 1)) 
)
(setq angl (dtr angl))
(setq bse (list 0 0 0)) ; set the base 0,0,0
(setq vec (polar bse angl dis)) ; obtain vector
(command "_.move" objset "" bse vec)
(princ)
)

(defun c:mvm ( / _toColour ) (vl-load-com)
 (defun _toColour ( entity colour )
   (entmod
     (if (assoc 62 (entget entity))
       (subst (cons 62 colour) (assoc 62 (entget entity)))
       (append (entget entity) (list (cons 62 colour)))
     )
   )
 )
 (mapcar
   (function
     (lambda ( fun string symbol default )
       (set symbol
         (cond
           (
             (
               (eval fun)
               (strcat string " <"
                 (rtos
                   (set symbol
                     (cond ( (eval symbol) ) ( default ))
                   )
                 )
                 "> : "
               )
             )
           )
           ( (eval symbol) )
         )
       )
     )
   )
   '(getdist getangle)
   '("\nEnter Distance " "\nEnter Angle ") '(*dis* *ang*) '(1.0 0.0)
 )
 (
   (lambda ( SelSet i / base disp )      
     (setq base (vlax-3D-point '(0. 0. 0.))
           disp (vlax-3D-point (polar '(0. 0. 0.) *ang* *dis*)))
     
     (if SelSet
       (while (setq entity (ssname SelSet (setq i (1+ i))))
         (_toColour entity 30)
         (vla-move (vlax-ename->vla-object entity) base disp)
       )
     )
   )
   (ssget) -1
 )
 (princ)
)
 

5