[编程交流] 自定义旋转/缩放

(defun c:test ()
 ;;  CAB version 1.0
 ;;  Calling routine to pass a center point & offset distance
 ;;  Routine will allow user to streatch outer circle
 ;;  Note if offset distance is a negative number the offset circle
 ;;  will be on the outside
 ;;
 ;;  Returns the distance to the 2nd pick point
 (defun ghostCircle (p1 r2 / *error* r1 c1 c2 el1 el2 gr rMin)
   (defun *error* (msg)
     (if (not
           (member msg '("Console break" "Function cancelled" "quit / exit abort" "" nil))
         )
       (princ (strcat "\nError: " msg))
     )
     (and c1 (entdel c1))
     (and c2 (entdel c2))
     (princ)
   )     ; end error function
   
   (setq rMin 0.001)
   (setq c1
          (entmakex (list (cons 0 "CIRCLE")
                          (cons 6 "BYLAYER")
                          (cons 8 "0")
                          (cons 10 p1)
                          (cons 39 0.0)
                          (cons 40 rMin) ; radius
                          (cons 62 256)
                          (cons 210 (list 0.0 0.0 1.0))
                    )
          )
   )
   (setq c2
          (entmakex (list (cons 0 "CIRCLE")
                          (cons 6 "BYLAYER")
                          (cons 8 "0")
                          (cons 10 p1)
                          (cons 39 0.0)
                          (cons 40 rMin) ; radius
                          (cons 62 256)
                          (cons 210 (list 0.0 0.0 1.0))
                    )
          )
   )
   (setq el1 (entget c1)
         el2 (entget c2)
   )
   (while (and (setq gr (grread 5)) (= (car gr) 5))
     (cond
       ((> (setq r1 (distance p1 (cadr gr))) rMin)
        (entmod (subst (cons 40 (distance p1 (cadr gr))) (assoc 40 el1) el1))
        (entupd (cdr (assoc -1 el1)))
        (cond
          ((> r1 (+ rMin r2))
           (entmod (subst (cons 40 (- r1 r2)) (assoc 40 el2) el2))
           (entupd (cdr (assoc -1 el2)))
          )
          (t ; minimize the inner circle
           (entmod (subst (cons 40 rMin) (assoc 40 el2) el2))
           (entupd (cdr (assoc -1 el2)))
          )
        )
       )
       (t ; minimize the outer circle
        (entmod (subst (cons 40 rMin) (assoc 40 el1) el1))
        (entupd (cdr (assoc -1 el1)))
       )
     )
   )
   (entdel c1)
   (entdel c2)
   r1
 )
 (setq pc (getpoint "\nPick center point."))
 (princ "\n Select new radius  ")
 (setq rad (ghostcircle pc 850.0)) ; center point & offset distance
 (princ rad)
 (princ)
)