[编程交流] 用户偏好LISP例程i

; Enter the filet radius as part of a command line entry f100 offset O234 circle c123-45 
; note - is used for decimal point
; original code and methology by Alan H
; assistance and code that worked by Lee-Mac
; OCT 2015
(   (lambda nil
       (vl-load-com)
       (foreach obj (cdar (vlr-reactors :vlr-command-reactor))
           (if (= "fillet-reactor" (vlr-data obj))
               (vlr-remove obj)
           )
       )
       (vlr-command-reactor "fillet-reactor" '((:vlr-unknowncommand . fillet-reactor-callback)))
   )
)
(defun filletrad ( / rad)
(setq rad (distof (substr com 2) 2))
           (if (<= 0.0 rad)
             (progn        
             (setvar 'filletrad rad)
             (vla-sendcommand fillet-reactor-acdoc "_.fillet ")
             )
             ) 
)
(defun makecirc ( / rad radd)
(setq rad (distof (substr com 2) 2))
           (if (<= 0.0 rad)
           (progn 
           (setvar 'circlerad rad)
           (setq pt (getpoint "Pick centre pt"))       
           (vla-sendcommand fillet-reactor-acdoc "_.Circle !pt  ")       
           )
           )
)
(defun offdist ( / dist)
(setq dist (distof (substr com 2) 2))
           (if (<= 0.0 dist)
           (progn        
           (setvar 'offsetdist dist)
           (vla-sendcommand fillet-reactor-acdoc "_.Offset  ")
           )
           )
)
(defun pipeoff ( / dist)
(setq dist (distof (substr com 2) 2))
           (if (<= 0.0 dist)
           (progn
           (setq poff (strcat "P" (rtos dist 2 3)))
           (if (not poff)(load "Pipe offsets"))
           (vla-sendcommand fillet-reactor-acdoc poff)
           )
           )
)
(defun fillet-reactor-callback ( obj com )
(setq com (vl-string-translate "-" "." (strcase (car com))))
   (cond   
       (   (and
           (wcmatch com "~*[~F.0-9]*")
           (wcmatch com "F*")
           (wcmatch com "~F*F*")
           (wcmatch com "~*.*.*")
           ) ; and
           (filletrad) 
        ) 
        (  (and
           (wcmatch com "~*[~C.0-9]*")
           (wcmatch com "C*")
           (wcmatch com "~C*C*")
           (wcmatch com "~*.*.*")
           ) ;and
           (makecirc) 
        )
        (  (and
           (wcmatch com "~*[~O.0-9]*")
           (wcmatch com "O*")
           (wcmatch com "~O*O*")
           (wcmatch com "~*.*.*")
           ) ; and
           (offdist) 
        )
(  (and
           (wcmatch com "~*[~P.0-9]*")
           (wcmatch com "P*")
           (wcmatch com "~P*P*")
           (wcmatch com "~*.*.*")
           ) ; and
           (pipeoff) 
        )
   ) ; master cond
) ; defun
(princ)
(or fillet-reactor-acdoc
   (setq fillet-reactor-acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(princ)

Your Code Here