- 积分
- 8073
- 明经币
- 个
- 注册时间
- 2018-7-10
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 纵横八方 于 2019-10-30 20:25 编辑
;;;其中xyp-是院长的函数,需要E派工具加持
(defun c:xm(/ delss dxf1 ent l1 name pt0 pt1 S1 S2 S3);;;十分镜像
(setq S1 (ssget))
(setq S2 (ssget))
(gxl_error_init2 'delss 1)
(defun delss()(vl-cmdf "erase" S3 ""))
(setq ent (entlast))
(entmake (list '(0 . "LINE") (cons 10 (xyp-9pt s2 1)) (cons 11 (xyp-9pt s2 7)) (cons 62 2)))
(entmake (list '(0 . "LINE") (cons 10 (xyp-9pt s2 7)) (cons 11 (xyp-9pt s2 9)) (cons 62 2)))
(entmake (list '(0 . "LINE") (cons 10 (xyp-9pt s2 9)) (cons 11 (xyp-9pt s2 3)) (cons 62 2)))
(entmake (list '(0 . "LINE") (cons 10 (xyp-9pt s2 3)) (cons 11 (xyp-9pt s2 1)) (cons 62 2)))
(entmake (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (xyp-9pt S2 1)) (cons 11 '(-1 -1 0)) (cons 62 1)))
(entmake (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (xyp-9pt S2 7)) (cons 11 '(-1 1 0)) (cons 62 1)))
(entmake (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (xyp-9pt S2 9)) (cons 11 '(1 1 0)) (cons 62 1)))
(entmake (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (xyp-9pt S2 3)) (cons 11 '(1 -1 0)) (cons 62 1)))
(entmake (list '(0 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") (cons 10 (xyp-9pt S2 5)) (cons 11 '(1 0 0)) (cons 62 1)))
(entmake (list '(0 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline") (cons 10 (xyp-9pt S2 5)) (cons 11 '(0 1 0)) (cons 62 1)))
(setq S3 (xyp-sselentnext ent))
(setq l1 (MC:ENTSEL1 "请选择直线或射线:" '((0 . "ray,xline,line")) "\n所选对像不符合要求!"))
(setq name (assoc 0 (setq dxf1 (entget (car l1)))))
(cond
((or (= (cdr name) "RAY") (= (cdr name) "XLINE"))
(setq pt0 (cdr (assoc 10 dxf1 )) pt1 (mapcar '- pt0 (cdr (assoc 11 dxf1 )))))
((= (cdr name) "LINE")
(setq pt0 (cdr (assoc 10 dxf1 )) pt1 (cdr (assoc 11 dxf1 ))))
)
(vl-cmdf "mirror" S1"" "non" pt0 "non" pt1 "n")
(vl-cmdf "erase" S3 "")
(gxl_error_end2)
)
(defun MC:ENTSEL1 (MSG FIL ERRMSG / E PF SS RT ERR);;MSG:提示字符串,FIL:dxf过滤表,ERRMAG:出错提示信息
(setq E T PF (getvar 'PICKFIRST))
(or ERRMSG (setq ERRMSG "无效的对象。"))
(setvar 'PICKFIRST 1)
(while E
(if (setq E (apply 'entsel (cond (MSG (list MSG)))))
(cond
((vl-consp E)
(setq SS (ssadd (car E) (ssadd)))
(sssetfirst nil SS)
(setvar "nomutt" 1)
(if (setq SS (ssget "_I" FIL))
(setq RT E E nil)
(progn (princ ERRMSG) (setq E T)))
(setvar "nomutt" 0))
(T (setq RT E E nil))
)
(cond
((= (setq ERR (getvar 'ERRNO)) 7)
(setq E T)
(princ "未选择对象。"))
((= ERR 52) (setq E nil))
)
)
)
(setvar 'PICKFIRST PF)
RT
)
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
评分
-
查看全部评分
|