怎样改成镜像后的图形是块 原图形还是原来的样子。 程序默认是不删除原对象， 默认...

李青松

程序(defun c:f2() (command  "ortho" "on" "mirror" (ssget) "" pause pause "n"))
怎样改成镜像后的图形是块 原图形还是原来的样子。
程序默认是不删除源对象， 默认是用两点进行镜像。

下面的程序供参考;|
          左健指定镜像线两点；右键选择镜像线线 ；
          每个里面仍然是原来的左键删除源对象，右键保留源对象
          镜像后做成块方便修改
       |;

       (defun pp( ss stnlist /)
            (setq p1 (getpoint "\n指定镜像线的第一点："))
            (setq p2 (getpoint p1 "\n指定镜像线的第二点："))
            (setq mp (mapcar '(lambda(x y)(/(+ x y)2)) p1 p2))
            (bb ss mp)(setq mb(entlast))
            (command "mirror"  mb"" "non"p1 "non"p2 "N")
            (command "explode" mb "")
            (setq ss(ssget "P"))
            (princ "\n左键删除源对象，右键保留源对象！" )
            (setq loop T)
            (while loop
                 (setq code (grread T 8))
                 (cond
                      ((= (car code) 3)     (command "erase" ss "") (setq loop nil))         
                      ((= (car code) 11)    (setq loop nil))            
                      ((= (car code) 25)    (setq loop nil))  
                 );cond
            );while
       ) ;defun

       (defun ob(ss /)
           (setq en (car (myentsel "\n指定镜像线：" '((0 . "LINE")))))
           (setq p1 (car (getLptlst en)))
           (setq p2 (cadr (getLptlst en)))
           (setq mp (mapcar '(lambda(x y)(/(+ x y)2)) p1 p2))
           (bb ss mp)
           (setq mb(entlast))
           (command "mirror" mb "" p1 p2 "N")
           (command "explode" mb "")
           (setq ss(ssget "P"))
           (princ "\n左键删除源对象，右键保留源对象！" )
           (setq loop T)
           (while loop
                 (setq code (grread T 8))
                 (cond
                      ((= (car code) 3)     (command "erase" ss "") (setq loop nil))               

                      ((= (car code) 11)    (setq loop nil))               
                      ((= (car code) 25)    (setq loop nil))               
                 );cond
           );while
       );defun

      (defun bb ( bent bpoint / bname )

        (setq bname (substr (rtos (getvar 'cdate) 2 8)10 8) )
  
        (command "-block"  bname "non"bpoint bent "" )

        (command "-insert" bname "non"bpoint "" "" "" )

        (princ)

      )

(defun c:tt (/ ss en p1 p2 loop code test)

   (setq ss (ssget) lng(sslength ss ) i 0 ptslist nil stnlist nil)
   (repeat lng
       (setq stn(ssname ss i)
             stnlist(cons stn stnlist)
             stnv(vlax-ename->vla-object stn)
       )
       (vla-getboundingbox stnv 'stnp1 'stnp2)
       (setq stnp1 (vlax-safearray->list stnp1)
             stnp2 (vlax-safearray->list stnp2)
             ptslist (cons p1 ptslist)
             ptslist (cons p2 ptslist)
       )
       (setq  i(1+ i) )
   )

   (setq loop1 T)
   (while loop1
    (setq code (grread T 8))
    (cond
     ((= (car code) 3)     (pp ss stnlist))                    
     ((= (car code) 11)    (ob ss))                  
     ((= (car code) 25)    (ob ss))               
    );cond
   );while
   (princ)
);end

  (defun myentsel (msg fil / ret)
    (setq ret (entsel msg))
    (if (and ret (ssget (cadr ret) fil))
        ret
    )
  );

  (defun getLptlst (ename / pts x )
     (setq pts '())
     (mapcar '(lambda (x)
                  (if (or (= (car x) 10) (= (car x) 11))
                   (setq pts (cons (cdr x) pts))
                  )
                 )
              (entget ename)
     );_mapcar
     (reverse pts)
  );_defun

llsheng_73

你想到了就自己云实现它，没有免费义工
特别是拿一段别人的来叫人按你的想法修改，一般情况真很难接受。如果是你自己的，那么对于你来说实现你的目的对于你来说根本不难

自贡黄明儒

看标题，你需要的是拷贝

李青松

高手就当是操练一下，搞不出来也没关系的。互相帮忙，我也帮过别人不少。

ysq101

哈哈..楼主... 高手们都被伸手党搞怕了
还是自己学学吧...
我的理解你的意思也是COPY
或 对称对象后  再将图形按中心线再对称回来

xyp1964

;; 愿意给就给，少说风凉话

李青松

xyp1964 发表于 2014-6-26 13:06
;; 愿意给就给，少说风凉话

还是搞个共享版，在e派里用也有问题，
程序显示
f2; 错误: 要绑定的对象不正确: (I RET VAL)
运行的时候有点慢

xyp1964

李青松 发表于 2014-6-26 14:46
还是搞个共享版，在e派里用也有问题，
程序显示
f2; 错误: 要绑定的对象不正确: (I RET VAL)

;; 跟绑定无关
;; 都成块的效果

李青松

xyp1964 发表于 2014-6-26 19:40
;; 跟绑定无关
;; 都成块的效果

原图形不要成块