[编程交流] 有obje的lisp例程

(defun c:bored ( / cir cnt gr lst n d )
 ;; © Lee Mac 2010
 (setq lst (list (getvar 'viewctr) (getvar 'viewctr)) cnt 0)
 
 (while (eq 5 (car (setq gr (grread nil 13 0))))
   (redraw)
   (setq cir nil n 0 lst (append lst (list (last lst) (cadr gr)))
         cnt (1+ cnt))
   
   (if (< 100 cnt) (setq lst (cddr lst)))
   
   (repeat 50
     (setq d (/ (distance (car lst) (last lst)) 4.))
     (repeat 4
       (setq cir (cons (polar (car lst) (* (setq n (1+ n)) (/ (* pi 2) 50)) d) cir))
       (setq d (/ d 2.))
     )
   )
   (grvecs (append (list (rem (/ cnt 100) 255)) lst cir))
 )
 (redraw)
 (princ)
)

(defun c:Test (/ obj block gr)
 ;; Alan J. Thompson, 06.22.10
 (if
   (and
     ;;(setq obj (AT:Entsel nil "\nSelect block: " '("LV" (0 . "INSERT")) nil))
     (setq obj (car (entsel "\nSelect block: ")))
     (eq "INSERT" (cdr (assoc 0 (entget obj))))
     ;;(setq block (vla-copy obj))
     (not
       (vl-catch-all-error-p
         (setq block (vl-catch-all-apply
                       (function vla-copy)
                       (list (vlax-ename->vla-object obj))
                     )
         )
       )
     )
   )
    (while (and (eq 5 (car (setq gr (grread T 15 2)))) (vl-consp (cadr gr)))
      (vla-put-insertionpoint block (vlax-3d-point (trans (cadr gr) 1 0)))
      (vla-put-rotation block (+ (vla-get-rotation block) 0.02))
    )
 )
 (princ)
)
(defun c:Test2 (/ ss lst)
 ;; Alan J. Thompson, 06.22.10
 (if (setq ss (AT:SS->List (ssget "_:L") T))
   (while (and (eq 5 (car (setq gr (grread T 15 2)))) (vl-consp (cadr gr)))
     (if (> (length (setq lst (cons (vlax-3d-point (trans (cadr gr) 1 0)) lst))) 1)
       (foreach x ss
         (vla-move x (cadr lst) (car lst))
         (vla-rotate x (car lst) 0.015)
       )
     )
   )
 )
 (princ)
)
(defun AT:SS->List (SS VLA)
 ;; Convert selection set to list of ename or vla objects
 ;; SS - SSGET selection set
 ;; VLA - T for vla objects, nil for ename
 ;; Alan J. Thompson, 04.01.10
 (if (eq 'PICKSET (type SS))
   ((lambda (i / l)
      (while (setq e (ssname SS (setq i (1+ i))))
        (cond (VLA (setq l (cons (vlax-ename->vla-object e) l)))
              ((setq l (cons e l)))
        )
      )
    )
     -1
   )
 )
)

 
(defun c:spinbolt (/ obj rot rot+)
 (vl-load-com)
 (setq obj (vlax-ename->vla-object (car (entsel))))
 (setq rot (vla-get-rotation obj))
 (setq inspnt (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'InsertionPoint))))
 (setq x (nth 0 inspnt))
 (setq y (nth 1 inspnt))
 (setq z (nth 2 inspnt))
 (setq rot+ (/ (* 2 pi) 100))
 (setq rot- (- rot+ (* rot+ 2)))
 (setq drop (/ 0.3 100))
 (repeat 1000
   (setq inspnt (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'InsertionPoint))))
   (setq z (nth 2 inspnt))
   (setq nz (- z drop))
   (setq nins (vlax-3d-point (list x y nz)))
   (vlax-put-property obj 'InsertionPoint nins)
   (setq rot (+ rot- rot))
   (vla-put-rotation obj rot)
   (vla-update obj)
   )
 (vlax-release-object obj)
 (princ)
 )