一个镜像的VLISP代码

Lisphk · 发表于 2016-9-22 19:44:44

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Lisphk 于 2016-9-22 19:50 编辑

一个镜像的VLISP代码

;;镜像
(defun c:tt (/ *error* der ent j p1 p2 pt ss uflag)
(vl-load-com)
(defun *error* (msg)
(and
uflag
(vla-endundomark doc)
)
(or
(wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(setq doc (cond
(doc)
((vla-get-activedocument (vlax-get-acad-object)))
)
)
(if (setq j -1
ss (ssget "_:L")
)
(while (progn
(setq ent (entsel "\nSelect Mirror Line: "))
(cond
((vl-consp ent)
(if (not (vl-catch-all-error-p (setq pt
(vl-catch-all-apply
(function vlax-curve-getclosestpointto)
(list
(car ent)
(cadr ent)
)
)
)
)
)
(progn
(setq uflag (not (vla-startundomark doc)))
(setq der (angle '(0 0 0)
(vlax-curve-getfirstderiv
(car ent)
(vlax-curve-getparamatpoint
(car ent) pt
)
)
)
)
(mapcar
(function set)
'(p1 p2)
(mapcar
(function vlax-3d-point)
(list pt (polar pt der 1.))
)
)
(while (setq ent (ssname ss (setq j (1+ j))))
(vla-mirror (vlax-ename->vla-object ent) p1 p2)
)
(setq uflag (vla-endundomark doc))
)
(princ "\n** Invalid Object Selected **")
)
)
(t
(princ "\n** Nothing Selected **")
)
)
)
)
)
(princ)
)

;;镜像       
(defun c:tt (/ *error* der ent j p1 p2 pt ss uflag) 
  (vl-load-com) 
  (defun *error* (msg) 
    (and 
      uflag 
      (vla-endundomark doc) 
    ) 
    (or 
      (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") 
      (princ (strcat "\n** Error: " msg " **")) 
    ) 
    (princ) 
  ) 
  (setq doc (cond 
              (doc) 
              ((vla-get-activedocument (vlax-get-acad-object))) 
            ) 
  ) 
  (if (setq j -1 
            ss (ssget "_:L") 
      ) 
    (while (progn 
             (setq ent (entsel "\nSelect Mirror Line: ")) 
             (cond 
               ((vl-consp ent) 
                 (if (not (vl-catch-all-error-p (setq pt 
                                                      (vl-catch-all-apply 
                                                                          (function vlax-curve-getclosestpointto) 
                                                                          (list 
                                                                                (car ent) 
                                                                                (cadr ent) 
                                                                          ) 
                                                      ) 
                                                ) 
                          ) 
                     ) 
                   (progn 
                     (setq uflag (not (vla-startundomark doc))) 
                     (setq der (angle '(0 0 0) 
                                      (vlax-curve-getfirstderiv 
                                                                (car ent) 
                                                                (vlax-curve-getparamatpoint 
                                                                                            (car ent) pt 
                                                                ) 
                                      ) 
                               ) 
                     ) 
                     (mapcar 
                       (function set) 
                       '(p1 p2) 
                       (mapcar 
                         (function vlax-3d-point) 
                         (list pt (polar pt der 1.)) 
                       ) 
                     ) 
                     (while (setq ent (ssname ss (setq j (1+ j)))) 
                       (vla-mirror (vlax-ename->vla-object ent) p1 p2) 
                     ) 
                     (setq uflag (vla-endundomark doc)) 
                   ) 
                   (princ "\n** Invalid Object Selected **") 
                 ) 
               ) 
               (t 
                 (princ "\n** Nothing Selected **") 
               ) 
             ) 
           ) 
    ) 
  ) 
  (princ) 
)

longer1000 · 发表于 2016-9-23 00:23:08

牛叉呀，强强强

yoyoho · 发表于 2016-9-23 07:16:03

谢谢 Lisphk 分享学习了!!!!!

adc · 发表于 2016-9-23 08:56:03

;; Mirror SelectionSet about selected object
;;框选对象镜像
(defun c:ww nil (QuickMirror nil nil))

;; Mirror SelectionSet about selected object, delete SelectionSet
;;框选对象镜像,并删除原框选线
(defun c:wwa  nil (QuickMirror nil t))

(defun QuickMirror ( single delete / *error* _StartUndo _EndUndo doc ss sel p1 p2 i o ) (vl-load-com)

  (defun *error* ( msg )
(if doc (_EndUndo doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
      (princ (strcat "\n** Error: " msg " **")))
(princ)
  )

  (defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
  )

  (defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
   (vla-EndUndoMark doc)
)
  )

  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

  (if (or single (setq ss (ssget "_:L")))
(while
   (progn (setvar 'ERRNO 0) (setq sel (entsel "\n请选择对象镜像: "))
      (cond
      (
         (=  7 (getvar 'ERRNO)) (princ "\n** 错了,再试一次 **")
      )
      (
         (and sel
            (not
            (vl-catch-all-error-p
               (setq p1
                  (vl-catch-all-apply 'vlax-curve-getClosestPointto
                  (list (car sel) (trans (cadr sel) 1 0))
                  )
               )
            )
            )
         )

         (setq p2
            (polar p1
            (angle '(0. 0. 0.)
               (vlax-curve-getFirstDeriv (car sel)
                  (vlax-curve-getParamatPoint (car sel) p1)
               )
            )
            1.
            )
         )

         (setq p1 (vlax-3D-point p1) p2 (vlax-3D-point p2))

         (_StartUndo doc)
         (if ss
            (repeat (setq i (sslength ss))
            (vla-mirror (setq o (vlax-ename->vla-object (ssname ss (setq i (1- i))))) p1 p2)
            (if delete  (vla-delete o))
            )
            (progn
            (vla-mirror (setq o (vlax-ename->vla-object (car sel))) p1 p2)
            (if delete  (vla-delete o))
            )
         )
         (_EndUndo doc)
      )
      )
   )
)
  )
  (princ)
)

sicky111 · 发表于 2016-9-23 13:26:29

很强啊……

HLCAD · 发表于 2016-9-24 18:00:26

感谢楼上的两位！

chen7560152 · 发表于 2020-4-8 15:35:59

感谢两位大神

账号		自动登录	找回密码
密码			立即注册

[每日一码] 一个镜像的VLISP代码

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分