距离要可以改成相对原图形与复制后的距离就好了
本帖最后由 小菜123 于 2014-7-14 10:25 编辑
试用了一下，因为自己使用习惯的原因，做了点修改，加了90度和45度的极轴追踪，为了简化，去掉几个键的功能，拷贝时可以使用快捷键定义的zoom w ;zoom p ;和一个自定义的view r o命令（没有考虑大小写的不同，只针对自己的定义命令），捕捉改为根据系统捕捉方式，发上源码供大家参考：(DEFUN C:c (/ SS PT SIZE OLDOSBB PT1 NEARPT
G2 H D LST PTXPTY PTT1 PTT2
PTT3 PTT4 AERROR Aerror_endolderr PT0 SS0
APT1 JULI zhuyi1 zhuyi2 F3F8 pt0x pt0y
STARTPT WS ASC REAL cl wpt1 wpt2 get_osmode
)
(defun Aerror(x)
(Aerror_end)
(AND oldos (COMMAND "ERASE" SS ""))
)
(defun Aerror_end ()
(setq *error* olderr)
(ifoldos
(setvar "osmode" oldos)
)
(ifoldCM
(setvar "cmdecho" oldCM)
)
(command "_.undo" "e")
(REDRAW)
(prinC)
)
;;;返回捕捉模式字串
(DEFUN get_osmode (/ cur_mode mode$)
(SETQ mode$ "")
(IF (< 0 (SETQ cur_mode (GETVAR "osmode")) 16384)
(MAPCAR (FUNCTION (LAMBDA (x)
(IF (NOT (ZEROP (LOGAND cur_mode (CAR x))))
(IF (ZEROP (STRLEN mode$))
(SETQ mode$ (CADR x))
(SETQ mode$ (STRCAT mode$ "," (CADR x)))
)
)
)
)
'((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$
)
;;====================程序开始================
(IF (SETQ SS0 (SSGET ":L"))
(SETQ PT0 (getpoint "\n选择复制基点:"))
)
(IF (AND SS0 PT0)
(PROGN
(setq olderr*error*
*error* Aerror
)
(setq oldos (getvar "osmode")
oldCM (getvar "cmdecho")
)
(setq F8 (getvar "ORTHOMODE")
F3 T ws(vlax-Create-Object "WScript.Shell")
)
;;(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "nomutt" 0)
(setq zhuyi1 "\n点取位置或\n[转90度(A)/左右翻(D)/上下翻(S)/对齐(F)/改转角(G)/改基点(T)/默认<";;;/大1倍(+)/小一倍(-)/量取(Z)
zhuyi2 "mm>(空格)]"
)
(command "_.undo" "be")
(IF *JULI*
(setq juli *JULI*)
(setq juli 100)
)
(WHILE pt0
(if pt1
(setqpt pt1
pt0pt1
SS SS0
PT0X (mapcar '+ pt0 '(1 0 0))
PT0y (mapcar '+ pt0 '(0 1 0))
)
(setqpt pt0
SS SS0
PT0X (mapcar '+ pt0 '(1 0 0))
PT0y (mapcar '+ pt0 '(0 1 0))
)
)
(command "_.copy" SS "" "0,0" "@")
(PRINC (strcat zhuyi1 (rtos juli 2) zhuyi2))
(while PT
(setqBB(grread T 5 1)
STARTPT(CADR BB)
)
(cond
((= (car BB) 5)
(SETQ PT1 STARTPT)
(redRaw)
(setq size (* (getvar "viewsize") 2))
(if (AND F3
(not (zerop (strlen (get_osmode)))) ;;有捕捉
(gxl-Sel-ReDrawSel SS 2)
(setq
nearpt (osnap PT1 (get_osmode)) ;;(osnap PT1 "_ENDP,_MID,_INT,NEA")
)
) ; 取得的捕捉点,端点，中点，交点,最近点.
(PROGN
(setq g2 nearpt)
(setq h (/ (getvar "viewsize")
(cadr (getvar "screensize"))
)
d (getvar "pickbox")
lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h))
ptx (car g2)
pty (cadr g2)
)
(foreach x lst
(setq ptt1 (list (- ptx x) (- pty x))
ptt2 (list (+ ptx x) (- pty x))
ptt3 (list (+ ptx x) (+ pty x))
ptt4 (list (- ptx x) (+ pty x))
)
(grvecs
(list 2 ptt1 ptt2 ptt2 ptt3 ptt3 ptt4 ptt4 ptt1)
)
)
(setq pt1 g2)
(gxl-Sel-ReDrawSel SS 1)
)
)
(IF (AND (= G2 NIL) (= F8 1))
(PROGN
(setq PT1 STARTPT)
(IF
(OR (< (* pi 0.25) (ANGLE PT1 PT0) (* pi 0.75))
(< (* pi 1.25) (ANGLE PT1 PT0) (* pi 1.75))
)
(SETQ PT1
(inters pt1
(polar pt1
(+ (angle pt0 pt0Y) (* pi 0.5))
1.0
)
pt0
pt0Y
nil
)
)
(SETQ PT1
(inters pt1
(polar pt1
(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
pt0X
nil
)
)
)
)
)
(cond ((AND (= G2 NIL)
(or (< (angle pt0 startpt) (* 0.01 pi)) (> (angle pt0 startpt) (* 1.99 pi)));;;0度方向
);;and
;;(PROGN;;(princ (angle pt0 startpt))
(SETQ PT1
(inters pt1
(polar pt1
(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
pt0X
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 0.26 pi)) (> (angle pt0 startpt) (* 0.24 pi)));;;45度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1 (* 0.75 pi)
;;(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
(polar pt0 (* 0.25 pi) 1.0)
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 0.51 pi)) (> (angle pt0 startpt) (* 0.49 pi)));;;90度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1
(+ (angle pt0 pt0Y) (* pi 0.5))
1.0
)
pt0
pt0Y
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 0.76 pi)) (> (angle pt0 startpt) (* 0.74 pi)));;;135度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1 (* 1.25 pi)
;;(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
(polar pt0 (* 0.75 pi) 1.0)
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 1.01 pi)) (> (angle pt0 startpt) (* 0.99 pi)));;;180度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1 (* 1.5 pi)
;;(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
(polar pt0 pi 1.0)
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 1.26 pi)) (> (angle pt0 startpt) (* 1.24 pi)));;;225度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1 (* 1.75 pi)
;;(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
(polar pt0 (* 1.25 pi) 1.0)
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 1.51 pi)) (> (angle pt0 startpt) (* 1.49 pi)));;;270度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1 (* 2 pi)
;;(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
(polar pt0 (* 1.5 pi) 1.0)
nil
)
) ;;setq
)
((AND (= G2 NIL)
(and (< (angle pt0 startpt) (* 1.76 pi)) (> (angle pt0 startpt) (* 1.74 pi)));;;270度方向
);;and
(SETQ PT1
(inters pt1
(polar pt1 (* 2.25 pi)
;;(+ (angle pt0 pt0X) (* pi 0.5))
1.0
)
pt0
(polar pt0 (* 1.75 pi) 1.0)
nil
)
) ;;setq
)
);;cond
(GRVECS
(LIST 1314
PT0
PT1
1314
STARTPT
(mapcar '+ (LIST size 0 0) STARTPT)
1314
STARTPT
(mapcar '- STARTPT (LIST size 0 0))
1314
STARTPT
(mapcar '- STARTPT (LIST 0 size 0))
1314
STARTPT
(mapcar '+ (LIST 0 size 0) STARTPT)
)
)
(COMMAND "MOVE" SS "" PT PT1)
(SETQ PT PT1
G2 NIL
)
)
((= (car BB) 3) (SETQ PT NIL))
((member (car BB) '(11 25)) (SETQ pt0 NIL) (EXIT))
((member BB '((2 97) (2 65)))
(COMMAND "ROTATE" SS "" PT1 90)
)
((member BB '((2 71) (2 103)));;((2 82) (2 114)) 大小写的R
(redraw)
(COMMAND "ROTATE" SS "" PT1 pause)
)
((member BB '((2 70) (2 102)))
(REDRAW)
;;对齐
(setvar "osmode" oldos)
(initget 1)
(IF (SETQ APT1 (getpoint "\n选择第一个源点:"))
(PROGN
(COMMAND "align" SS "" APT1)
(princ "\n选择第一个目标点:")
(COMMAND pause)
(princ "\n选择第二个源点:")
(COMMAND pause)
(princ "\n选择第二个目标点:")
(COMMAND pause)
(COMMAND "" "N")
(REDRAW)
(setvar "osmode" 0)
)
(PRINC (strcat zhuyi1 (rtos juli 2) zhuyi2))
)
)
((member BB '((2 115) (2 83)))
(COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(1 0)) "Y")
)
;|
((member BB '((2 32)))
(IF JULI
(progn (setq pt1 (polar PT0 (ANGLE PT0 PT1) JULI))
(COMMAND "MOVE" SS "" PT PT1)
(SETQ PT nil)
)
)
)
|;
((and (null cl) (member BB '((2 32)))) (SETQ pt0 NIL) (EXIT)) ;;空格改为退出 cl是避免快捷键中的空格
((member BB
'((2 46)
(2 49)
(2 48)
(2 50)
(2 51)
(2 52)
(2 53)
(2 54)
(2 55)
(2 56)
(2 57)
)
)
(redraw)
(setq
ASC (CADR BB)
)
(setq real
(getreal
(car
(list ""
(vlax-invoke-method ws 'sendkeys (chr asc))
)
)
)
)
(setq pt1 (polar PT0 (ANGLE PT0 PT1) real))
(COMMAND "MOVE" SS "" pt PT1)
(SETQ *JULI* real
JULI*JULI*
PT NIL
)
)
;|
((member BB '((2 90) (2 122))) ;;;大小写的Z，与zoom冲突
(redraw)
(setq
juli (getdist
(strcat "\n输入复制距离<" (rtos juli 2) ">:")
)
)
(setq pt1 (polar PT0 (ANGLE PT0 PT1) JULI))
(COMMAND "MOVE" SS "" PT PT1)
(SETQ PT nil
*JULI* JULI
)
)
|;
((member BB '((2 100) (2 68)))
(COMMAND "mirror" SS "" PT1 (mapcar '- pt1 '(0 1)) "Y")
)
;;((member BB '((2 43) (2 61))) ;;+号
;; (COMMAND "scale" SS "" PT1 "2")
;; )
((member BB '((2 116) (2 84)))
(setvar "osmode" oldos)
(redRaw)
(IF (setq pt (getpoint "\n请选择新基点:"))
(PRINC (strcat zhuyi1 (rtos juli 2) zhuyi2))
(exit)
)
(setvar "osmode" 0)
)
;; ((equal BB '(2 45)) ;-号
;;(COMMAND "scale" SS "" PT1 "0.5")
;; )
((equal BB '(2 6))
(if (= f3 NIL)
(progn (setq f3 T) (prompt "\n<对象捕捉 开>"))
(progn (setq f3 NIL) (prompt "\n<对象捕捉 关>"))
)
(redraw)
)
((equal BB '(2 15))
(if (= f8 0)
(progn (setq f8 1) (prompt "\n<正交 开>"))
(progn (setq f8 0) (prompt "\n<正交 关>"))
)
(setvar "orthomode" f8)
(redraw)
)
((member BB '((2 39)
(2 95)
(2 90)
(2 79)
(2 77)
(2 32)
(2 87)
(2 80)
(2 45)
(2 86)
(2 73)
(2 69)
(2 82)
(2 10)
)
);;member
(if (equal BB '(2 10))
(progn
(cond ((equal cl '(2 87))
(redraw)
(gxl-Sel-ReDrawSel SS 2)
(command "_.zoom" "w")
(initget 1)
(setq wpt1 (getpoint "\nSpecify first corner:"))
(initget 1)
(setq wpt2 (getcorner wpt1 "\nSpecify opposite corner:"))
;;(while (/= 0 (getvar "cmdactive")) (vl-cmdf PAUSE))
(command wpt1 wpt2)
(PRINC (strcat zhuyi1 (rtos juli 2) zhuyi2))
)
((equal cl '(2 80)) (command "_.zoom" "p"))
((equal cl '(2 79)) (command "-view" "r" "o"))
)
(setq cl nil)
)
(setq cl bb);;else
)
)
)
)
;;END 内WHILE
)
;;END 外WHILE
) ;END progn
)
;;end if
(Aerror_end)
)
小菜123 发表于 2014-7-14 10:24 static/image/common/back.gif
试用了一下，因为自己使用习惯的原因，做了点修改，加了90度和45度的极轴追踪，为了简化，去掉几个键的功 ...
谢谢小菜老大
楼主，为什么增加不了圆心捕捉呢？增加程序的捕捉，偏偏就是圆心增加不了，其他都可以
不错支持，就是复制的时候会闪动，希望能出1.7版：）
不错啊。。。。。。。。马克一下
感谢楼主分享源码
发现一处BUG:在执行命令点选基点后(不移动鼠标),滚轮缩放后,被复制物体就不见了,选基点后选先移动一点再滚是没问题.
还有就是一个建议,建议保持用户默认的捕捉开关
dybdyb_1999 发表于 2014-7-28 15:36 static/image/common/back.gif
不错支持，就是复制的时候会闪动，希望能出1.7版：）
是的.
不好意思 现在刚刚说的BUG又没有出现了..
小菜123 发表于 2014-7-14 10:24 static/image/common/back.gif
试用了一下，因为自己使用习惯的原因，做了点修改，加了90度和45度的极轴追踪，为了简化，去掉几个键的功 ...
你这个好像用不了，加载不起
不能够下载 好伤心,注册好,努力的赚取点积分,,,,,,,,,,,,,