帮忙编写一个镜像命令，开始的时候选择镜像线，后面镜像不用再选择
本帖最后由 loveu515 于 2022-9-30 17:13 编辑求大神帮忙编写一个镜像命令
镜像命令开始的时候选择镜像线，后面镜像(后面再次用镜像命令的时候)不用再选择，默认一直是这条线，如果要换镜像线的话，输入一个命令再重新选择。
可以实现吗？
本帖最后由 纵横八方 于 2022-10-9 15:48 编辑
我帮你写的这个应该很满足你了 本帖最后由 ssyfeng 于 2022-9-30 15:57 编辑
试试是不是这个效果：
(defun c:tt (/ en en1 pt1 pt2)
(vl-load-com)
(setq en (car (entsel "\n选择镜像线："))
pt1 (vlax-curve-getStartPoint (vlax-ename->vla-object en))
pt2 (vlax-curve-getendPoint (vlax-ename->vla-object en))
)
(while (and en pt1 pt2 (setq en1 (car (entsel "\n选择对象："))))
(vl-cmdf "MIRROR" en1 "" pt1 pt2 "n")
)
(princ)
)
ssyfeng 发表于 2022-9-30 15:51
试试是不是这个效果：
(defun c:tt (/ en en1 pt1 pt2)
(vl-load-com)
谢谢，你写的这个命令也很好用。我上面表达的不清楚，非常抱歉。是第一次用镜像命令的时候选择镜像线，后面再用镜像命令的时候不用再选择镜像线，默认上次的那条。可以实现吗？{:1_1:} (defun c:t1(/objp pt n pt1 pt2 ss)
(if(or *test_en*(setq *test_en*(entsel "\n请选择镜像线：")))
(progn
(setq
obj(vlax-ename->vla-object (car *test_en*))
p(cadr *test_en*)
pt(vlax-curve-getclosestpointto obj p)
n(fix(vlax-curve-getparamatpoint obj pt))
pt1(vlax-curve-getpointatparam obj n)
pt2(vlax-curve-getpointatparam obj(1+ n))
)
(princ "\n请选择需镜像的图元：")
(if(setq ss(ssget))(command ".mirror" ss "" "_non" pt1 "_non" pt2 ""))
)
)
(prin1)
)
(defun c:t2()
(setq *test_en* nil)
(princ "\n已经消除T1命令镜像线")
(prin1)
)
xtjd 发表于 2022-10-7 14:06
(defun c:t1(/objp pt n pt1 pt2 ss)
(if(or *test_en*(setq *test_en*(entsel "\n请选择镜像线："))) ...
感谢你的帮助，我运行的T1的时候提示“错误参数太少”，是不是缺少支持啊 (defun c:MII(/ image_xunhuan);;;增强镜像-纵横八方
(DEFUN IMAGE_XUNHUAN(/ pt1 pt2 s2)
(VL-LOAD-COM)
(initget "S")
(if (= (setq S2 (Fsxm-ssget+ "\n请选择镜像对象或【S设置镜像轴】:" "S :S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,XLINE,POLYLINE,SPLINE,LWPOLYLINE")))) "S")
(PROGN (setq e1_enT (CAR (ENTSEL "\n请 点 选 镜 像 轴:")))
(IMAGE_XUNHUAN)
)
(PROGN
(if (= S2 NIL) (EXIT))
(SETQ pt1 (vlax-curve-getStartPoint (vlax-ename->vla-object e1_enT)))
(SETQ pt2 (vlax-curve-getendPoint (vlax-ename->vla-object e1_enT)))
(command "MIRROR" S2 "" "NON" pt1 "NON" pt2 "Y")
(IMAGE_XUNHUAN)
)
)
)
(IF (NULL e1_enT)
(PROGN (AND (setq e1_enT (CAR (ENTSEL "\n请 点 选 镜 像 轴:"))) (IMAGE_XUNHUAN)))
(PROGN (IMAGE_XUNHUAN))
)
)
;;参数:Msg:提示信息
;;参数:Kwd:选项关键字（支持多个关键字，如":E:S S",关键字之间用空格隔开，
;其中"S"为额外选项关键字（应摒避CAD内置于SSGET中的关键字）
;;参数:Fil:选集过滤表
;;返回:选集或额外选项关键字
(defun Fsxm-ssget+ (Msg Kwd Fil / Kwd0 pt var stop result *ACAD* *DOC* Fsxm-SplitPt2Str key_ssget)
(setq *ACAD*(vlax-get-acad-object))
(setq *DOC* (vla-get-ActiveDocument *ACAD*))
;;===============================================================
;;点化字串
(defun Pt2Str (pt)
(strcat (rtos (car pt) 2 20)
","
(rtos (cadr pt) 2 20)
","
(rtos (caddr pt) 2 20)
"\n"
)
)
;;===============================================================
;;;用分隔符解释字符串成表
(defun Fsxm-Split (string strkey / po strlst xlen)
(setq xlen (1+ (strlen strkey)))
(while (setq po (vl-string-search strkey string))
(setq strlst (cons (substr string 1 po) strlst))
(setq string (substr string (+ po xlen)))
)
(reverse (cons string strlst))
)
;;===============================================================
(defun Fsxm-entsel (msg filter)
(setq enp (entsel msg))
(if (or (= (type enp) 'str)
(and enp (ssget (cadr enp) filter));;点选
)
enp
)
)
;;===============================================================
(cond
((cadr (ssgetfirst)) (command "SELECT" (cadr (ssgetfirst)) "") (setq result (ssget "P" Fil)));;优化内容2：完善原程序在先选择后执行情况下，不过滤的bug，
(t
(setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
(setq kwd (strcase kwd))
(setq kwd_lst (Fsxm-Split kwd " "))
(initget (strcat Kwd0 " " kwd))
(setq var (fsxm-entsel Msg Fil))
(if (OR (member "SI" kwd_lst)(member ":S" kwd_lst));;优化内容1：支持(ssget ":E:S")模式
(if (and var (listp var))
(progn
(setq stop T)
(setq result(ssadd (car var)))
)
)
)
(if (NOT stop)
(cond
((and
(listp var);;说明Fsxm-entsel空选
(/= 52 (getvar "errno"))
)
(vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
(setq key_lst(list ":E" "M" ":S" "SI" ":E:S" ":S:E" ":L"))
(foreach x kwd_lst
(if (member x key_lst)
(cond
((or(= x ":E")(= x "M"))(setqkey_ssget ":E"))
((or(= x ":S")(= x "SI"))(setq key_ssget ":S"))
((or(= x ":E:S")(= x ":S:E")(= x ":L"))(setq key_ssget x))
)
)
)
(if key_ssget
(setq result (ssget key_ssget Fil))
(setq result (ssgetFil))
);;更新修正2022.5.12
);;空选之后变框选
((member var (fsxm-split Kwd0 " "))
(vla-sendcommand *doc* (strcat var "\n"))
(setq result (ssget Fil))
);响应用户手动输入的关键字（选择模式）
(t (setq result var))
)
)
)
)
result
)
;;================================================================================
;选择集与对象名表互转
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
;;=====================================================================================================================
;;; grread捕捉子函数
;;; name为移动的图元名，pt为光标点
;;; 返回值：如果有捕捉点则返回捕捉点，无则返回光标点
;;;http://bbs.mjtd.com/forum.php?mo ... hlight=%B2%B6%D7%BD
(defun osnappt (name pt / color d h k lst nearpt nearpt2 osmo pt1 pt2 pt3 pt4 pt5 ptx pty x)
(if name (entdel name))
(redraw)
(if (< (getvar "osmode") 16384);;打开捕捉
(progn
(setq color (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))
h (/ (getvar "viewsize") (cadr (getvar "screensize"))) d (getvar "pickbox")
lst (list (* d h) (* (- d 0.5) h) (* (+ d 0.5) h)) k (* 1.5 d h))
(if (setq nearpt (osnap pt "_END,_CEN,_NOD,_QUA,_INS,_TAN,_EXT"))(setq osmo 1))
(if (and(setq nearpt2 (osnap pt "_NEA"))(not (equal nearpt nearpt2 k)))
(setq osmo 2 nearpt nearpt2))
(if (and(setq nearpt2 (osnap pt "_MID"))(equal nearpt nearpt2 k))
(setq osmo 3 nearpt nearpt2))
(if (and(setq nearpt2 (osnap pt "_INT"))(equal nearpt nearpt2 k))
(setq osmo 4 nearpt nearpt2))))
(if name(entdel name))
(if nearpt
(progn
(setq ptx (car nearpt)pty (cadr nearpt))
(foreach x lst
(setq pt1 (list (- ptx x) (- pty x)) pt2 (list (+ ptx x) (- pty x))
pt3 (list (+ ptx x) (+ pty x)) pt4 (list (- ptx x) (+ pty x))
pt5 (list ptx (+ pty x)))
(cond
((= osmo 1)(grvecs (list color pt1 pt2 pt2 pt3 pt3 pt4 pt4 pt1)))
((= osmo 2)(grvecs (list color pt1 pt2 pt2 pt4 pt3 pt4 pt3 pt1)))
((= osmo 3) (grvecs (list color pt1 pt2 pt2 pt5 pt5 pt1)))
((= osmo 4) (grvecs (list color pt1 pt3 color pt2 pt4)))))
(setq pt nearpt)))
pt
)
纵横八方 发表于 2022-9-30 15:33
我帮你写的这个应该很满足你了
感谢，正是我想要的。谢谢你的帮助。:handshake
我把这个镜像命令弄成了两个，一个是填的Y，一个是填的N，分别加载的，这样就可以一个命令是删除原对象的，一个是不删除的。 loveu515 发表于 2022-10-8 11:36
感谢你的帮助，我运行的T1的时候提示“错误参数太少”，是不是缺少支持啊
在第一句斜杠后加个空格即可
(defun c:t1(/ objp pt n pt1 pt2 ss)
页:
[1]