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

(defun c:test2 ()
 ;;  CAB version 1.1
 ;;  Calling routine to pass a tangent point (p1) & offset distance (od)
 ;;  Routine will allow user to stretch outer circle using diameter
 ;;  Note if offset distance is a negative number the offset circle
 ;;  will be on the outside
 ;;
 ;;  Returns the 2nd pick point
 (defun ghostCircle (p1 od / *error* p2 d1 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)
   )
   ;;  p1 is a tangent point
   ;;  p2 is a tangent point with center at mid point of p1 p2
   (while (and (setq gr (grread 5)) (= (car gr) 5))
     (cond
       ((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
        (setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
        (cond
          ((< rMin (- d1 od))
           (setq el2 (subst (cons 40 (- d1 (/ od 2.))) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
          (t ; minimize the inner circle
           (setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
        )
       )
       (t ; minimize the outer circle
        (setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
       )
     )
   )
   (entdel c1)
   (entdel c2)
   p2
 )
 (setq pc (getpoint "\nPick center point."))
 (princ "\n Select new radius  ")
 (setq rad (ghostcircle pc 850.0))
 (princ rad)
 (princ)
)

    (entdel c1)
   (entdel c2)

    ; (entdel c1)
   ; (entdel c2)

  (setq rad (ghostcircle pc 850.0))

  (setq rad (ghostcircle pc -850.0))

(defun c:test2 ()
 ;;  CAB version 1.2
 ;;  Calling routine to pass a tangent point (p1) & offset distance (od)
 ;;  Routine will allow user to stretch outer circle using diameter
 ;;  Note if offset distance is a negative number the offset circle
 ;;  will be on the outside
 ;;
 ;;  Returns the 2nd pick point
 (defun ghostCircle (p1 od / *error* p2 d1 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) ; Minimum Radius allowed
   (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)
   )
   ;;  p1 is a tangent point
   ;;  p2 is a tangent point with center at mid point of p1 p2
   (while (and (setq gr (grread 5)) (= (car gr) 5))
     (cond
       ((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
        (setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
        (cond
          ((< rMin (- d1 (* od 2.)))
           (setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
          (t ; minimize the inner circle
           (setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
        )
       )
       (t ; minimize the outer circle
        (setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
       )
     )
   )
   ;(entdel c1) ; to remove the circle
   ;(entdel c2) ; to remove the circle
   p2
 )
 (setq pc (getpoint "\nPick center point."))
 (princ "\n Select new radius  ")
 (setq rad (ghostcircle pc 850.0))
 (princ rad)
 (princ)
)

(defun c:test2 ()
 ;;  CAB version 1.3
 ;;  Calling routine to pass a tangent point (p1) & offset distance (od)
 ;;  Routine will allow user to stretch outer circle using diameter
 ;;  Note if offset distance is a negative number the offset circle
 ;;  will be on the outside
 ;;  LayName if nil will use the curent layer
 ;;  Returns the 2nd pick point
 (defun ghostCircle (p1 od LayName / *error* p2 d1 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
   
   (or layName (setq layName (getvar "clayer")))
   (setq rMin 0.001) ; Minimum Radius allowed
   (setq c1
          (entmakex (list (cons 0 "CIRCLE")
                          (cons 6 "BYLAYER")
                          (cons 8 LayName)
                          (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 LayName)
                          (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)
   )
   ;;  p1 is a tangent point
   ;;  p2 is a tangent point with center at mid point of p1 p2
   (while (and (setq gr (grread 5)) (= (car gr) 5))
     (cond
       ((> (setq d1 (distance p1 (setq p2 (cadr gr)))) rMin)
        (setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
        (cond
          ((< rMin (- d1 (* od 2.)))
           (setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
          (t ; minimize the inner circle
           (setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
        )
       )
       (t ; minimize the outer circle
        (setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
       )
     )
   )
   ;(entdel c1) ; to remove the circle
   ;(entdel c2) ; to remove the circle
   p2
 )
 (setq pc (getpoint "\nPick center point."))
 (princ "\n Select new radius  ")
 (setq rad (ghostcircle pc 850.0 "0")) ; Layer name "0"
 (princ rad)
 (princ)
)

  (setq rad (ghostcircle pc 850.0 "Hulplijnen")) ; Layer name "0"

(defun c:test4 ()
 ;;  CAB version 1.4
 ;;  Calling routine to pass a tangent point (p1) & offset distance (od)
 ;;  Routine will allow user to stretch outer circle using diameter
 ;;  Note if offset distance is a negative number the offset circle
 ;;  will be on the outside
 ;;  LayName if nil will use the curent layer
 ;;  os when true will use the osnap if it is active
 ;;  Returns the 2nd pick point
 (defun ghostCircle (p1 od layName os / *error* get_osmode p2 d1 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
   
   ;;  CAB  10/5/2006
   ;;
   ;;  Function to return the current osmode setting in the form of a string
   ;;  If (getvar "osmode") = 175 
   ;;  (get_osmode)  returns   "_end,_mid,_cen,_nod,_int,_per"
   ;;  Usage
   ;;  (osnap (getpoint) (get_osmode))
   ;;
   (defun get_osmode (/ cur_mode mode$)
     (setq mode$ "")
     (if (< 0 (setq cur_mode (getvar "osmode")) 16383)
       (mapcar
         '(lambda (x)
            (if (not (zerop (logand cur_mode (car x))))
              (setq mode$ (strcat mode$ (cadr x)))
            ) )
         '((0 "_non,") (1 "_end,") (2 "_mid,") (4 "_cen,") (8 "_nod,") (16 "_qua,")
           (32 "_int,") (64 "_ins,") (128 "_per,") (256 "_tan,") (512 "_nea,")
           (1024 "_qui,") (2048 "_app,") (4096 "_ext,") (8192 "_par") )
       )
     )
     mode$
   )
   (defun CircleUpdate (p1 p2 od rMin el1 el2 / d1 gr c1 c2)
     (cond
       ((> (setq d1 (distance p1 p2)) rMin)
        (setq el1 (subst (cons 40 (setq r1 (/ d1 2.))) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) r1)) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
        (cond
          ((< rMin (- d1 (* od 2.)))
           (setq el2 (subst (cons 40 (/ (- d1 (* od 2.)) 2.)) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
          (t ; minimize the inner circle
           (setq el2 (subst (cons 40 rMin) (assoc 40 el2) el2))
           (setq el2 (entmod (subst (assoc 10 el1) (assoc 10 el2) el2)))
           (entupd (cdr (assoc -1 el2)))
          )
        )
       )
       (t ; minimize the outer circle
        (setq el1 (subst (cons 40 rMin) (assoc 40 el1) el1))
        (setq el1 (entmod (subst (cons 10 (polar p1 (angle p1 p2) (/ rMin 2.))) (assoc 10 el1) el1)))
        (entupd (cdr (assoc -1 el1)))
       )
     )
     p2
   )
   (or layName (setq layName (getvar "clayer")))
   (setq rMin 0.001) ; Minimum Radius allowed
   (setq c1
          (entmakex (list (cons 0 "CIRCLE")
                          (cons 6 "BYLAYER")
                          (cons 8 layName)
                          (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 layName)
                          (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)
   )
   ;;  p1 is a tangent point
   ;;  p2 is a tangent point with center at mid point of p1 p2
   (while (and (setq gr (grread 5)) (= (car gr) 5))
     (setq p2 (CircleUpdate p1 (cadr gr) od rMin el1 el2))
   )
   ;(entdel c1) ; to remove the circle
   ;(entdel c2) ; to remove the circle
   (setq p2 (if os (osnap p2 (get_osmode))p2))
   (or p2 (setq p2 (cadr gr))) ; catch any error with point
   (CircleUpdate p1 p2 od rMin el1 el2)
   p2
 )
 (setq pc (getpoint "\nPick center point."))
 (princ "\n Select new radius  ")
 (setq rad (ghostcircle pc 850.0 "0" t)) ; Layer name "0", t= use osmode if on
 (princ rad)
 (princ)
)