[编程交流] 仅在X轴和Y轴上复制

(Alert  ":: Lock_Copy_X&Y.lsp loaded ::\n\n\n:: Invoke by typing 'CX' (Copy on X-axis) or 'CY' (Copy on Y-axis) ::" )

(defun c:CX ( / ss) this localises ss so no need for set nil

; 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 0)))
(if (not poff)(load "Pipe offsets"))
(vla-sendcommand fillet-reactor-acdoc poff)
)
)
)
(defun projopen ( / Proj year)
(setq year (atoi (substr com 2 4)))
(if (< year 2014) 
(setq projno (strcat "EXPLORER \\\\cogg.local\\fs\\LCFC3\\DESIGN\\DATA\" (substr com 2 4) " Projects\" (substr com 2) "[url="file://\\Design\"]\\Design\\[/url]"))
(setq projno (strcat "EXPLORER P:\" (rtos year 2 0) " Projects\" (substr com 2) "[url="file://\\Design\"]\\Design\\[/url]")) 
)
(vla-sendcommand fillet-reactor-acdoc (STARTAPP projno)) 
)
(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 "~*[~D.0-9]*")
(wcmatch com "D*")
(wcmatch com "~D*D*")
(wcmatch com "~*.*.*")
) ; and
(projopen) 
)
( (and
(wcmatch com "~*[~P.0-9]*")
(wcmatch com "P*")
(wcmatch com "~P*P*")
(wcmatch com "~*.*.*")
) ; and
(pipeoff) 
)
) ; master cond
) ; defun
(or fillet-reactor-acdoc
(setq fillet-reactor-acdoc (vla-get-activedocument (vlax-get-acad-object)))
)

(defun c:test ( / ss)
 (setq ss (ssget))
 (command "._copy" ss "" "_multiple" pause)
 (while (/= 0 (getvar 'cmdactive))
   (command ".yz" "@" pause)
 )
 (princ)
)

;;----------------------------------------------------------------------;;
; Answer on how to fix multiple copy by Roy_043 14.03.2018: http://www.cadtutor.net/forum/showthread.php?94798-Copy-on-X-axis-only-and-Y-axis-only&p=699099&viewfull=1#post699099
; Credit to Roy_043
(defun c:CX ( / ss)
 (setq ss (ssget))
 (command "._copy" ss "" "_multiple" pause)
 (while (/= 0 (getvar 'cmdactive))
   (command ".yz" "@" pause)
 )
 (princ)
)
(defun c:CY ( / ss)
 (setq ss (ssget))
 (command "._copy" ss "" "_multiple" pause)
 (while (/= 0 (getvar 'cmdactive))
   (command ".xz" "@" pause)
 )
 (princ)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
   (strcat
       "\n:: Lock_Copy_X&Y.lsp loaded ::"
       "\n:: Invoke by typing 'CX' (Copy on X-axis) or 'CY' (Copy on Y-axis) ::"
   )
)
(princ)
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

;;----------------------------------------------------------------------;;
(defun c:MX ( / ss)
(setq *error* SS:error)
(SS:startundo)
(setq cmde (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setq orthom (getvar "orthomode"))
(setvar 'cmdecho 0)
(setvar 'osmode 83)
(setvar 'orthomode 1)
(setq ss (ssget))
(command "._move" ss "" pause ".yz" "@" pause)
(setq ss nil)
(*error* nil)
(princ)
)
(defun c:MY ( / ss)
(setq *error* SS:error)
(SS:startundo)
(setq cmde (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setq orthom (getvar "orthomode"))
(setvar 'cmdecho 0)
(setvar 'osmode 83)
(setvar 'orthomode 1)
(setq ss (ssget))
(command "._move" ss "" pause ".xz" "@" pause)
(setq ss nil)
(*error* nil)
(princ)
)
(defun SS:error (errmsg)
(and acDoc (vla-EndUndoMark acDoc))
(and errmsg
        (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
        (princ (strcat "\n<< Error: " errmsg " >>"))
        )
(setvar 'cmdecho cmde)
(setvar 'osmode os)
(setvar 'orthomode orthom)
)
(defun SS:startundo ()
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
)
(vl-load-com)
(princ
(strcat
        "\nLock_Move_X&Y.lsp loaded"
        "\nInvoke by typing 'MX' (Move on X-axis) or 'MY' (Move on Y-axis)"
        )
)
(princ)
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;