求一个1/4镜像的lisp

Smile cop

1/4镜像的lisp的思路大概是：首先提示要求先选择对象再拾取四角镜像的中心点<选对象确定中心>:
谢谢！

XDSoft

你说的这些工具你在用什么软件？ 把你执行的过程作动画文件贴上来。

你这个功能是做啥的，都详细说说。

Smile cop

1/4镜像就是这样的，比如把一个矩形就可以做出其他三个，注意是mirror，要文字不要镜像，这只是一个简单例子，要求对于其他图元也通用。程序执行的过程提示是：首先提示要求先选择对象；再拾取四角镜像的中心点<选对象确定中心>:

Free-Lancer

[pcode=lisp,true](defun c:tt (/ ss p1 p2 s1 en)
  (if (and (setq ss (ssget))
             (setq pt (getpoint "\nCenter Point: "))
      )
    (progn
      (setq p1 (polar pt 0. 1.)
              p2 (polar pt (* 0.5 pi) 1.)
              en (entlast)
              s1 (ssadd)
      )
      (vl-cmdf ".undo" "g")
      (vl-cmdf ".mirror" ss "" "_none" pt "_none" p1 "N")
      (while (setq en (entnext en))
          (ssadd en s1)
      )
      (vl-cmdf ".mirror" ss "" "_none" pt "_none" p2 "n")
      (vl-cmdf ".mirror" s1 "" "_none" pt "_none" p2 "n")
      (vl-cmdf ".undo" "e")
    )
  )
  (princ)
)[/pcode]

Lispboy

我用矩阵方法写一个。用前请加载高飞鸟斑竹的通用矩阵库函数。
我给矩阵函数库添加了下面几个函数。
[pcode=lisp,true]
;;通用矩阵函数；
; by Lispboy  ;
;给VLAX增加 TransformedCopy;
(defun Ent:TransformedCopy(ss mat / e e1 i obj ss1)
   (setq i -1)
   (setq ss1 (ssadd))
   (while (setq e (ssname ss (setq i (1+ i))))
      (setq e1 (entmakex (entget e)))
      (setq obj (vlax-ename->vla-object e1))
      (vla-transformby obj (vlax-TMatrix mat))
      (ssadd (entlast) ss1)
   )
   ss1
)
;选择集合并;
(defun Ent:PicksetUnion(ss1 ss2 / e i)
   (setq i -1)
   (while (setq e (ssname ss2 (setq i (1+ i))))
      (ssadd e ss1)
   )
)   
;;测试四角镜像程序;
;使用矩阵方法;
;
(defun c:tt( / mat_x mat_y  pt px py ss ss1)
   (if (and (setq ss (ssget))
            (setq pt (getpoint "\n四角镜像中心点<退出>:"))
       )
      (progn
         (setq px (polar pt 0.0 1e5)
               py (polar pt (/ pi 2) 1e5)
               mat_x (MAT:Reflect pt px) ;; 沿X轴镜像变换矩阵
               mat_y (MAT:Reflect pt py) ;;  沿Y轴镜像变换矩阵
         )
         (setq ss1 (Ent:TransformedCopy ss mat_x))
         (Ent:PicksetUnion ss ss1)
         (Ent:TransformedCopy ss mat_y)
      )
  )
  (princ)
)
[/pcode]

dwg001

(while (setq en (entnext en))
         (ssadd en s1)
     )
[size=+0]Free-Lancer 楼主这句用得很好，赞一个。

Smile cop

Free-Lancer 发表于 2013-5-2 22:22

                               
登录/注册后可看大图

(defun c:tt (/ ss p1 p2 s1 en)
  (if (and (setq ss (ssget))
             (setq pt (getpoint "\nCen ...

可否把程序改下：在选择镜像中心的时候能够选择图形，并求出图形的中心作为要镜像的中心；最后程序执行完后可否继续执行，不要自动结束命令？以上，谢谢！！！

eachy

重拾下API，变换就不用矩阵了[pcode=lisp,true](defun c:tt (/ ss ss1 s1 p1 p2 s1 box pt)
  (while (and (progn
                (princ "\n选择镜像物体....")
                (setq ss (ssget))
              )
              (progn
                (princ "\n选择镜像中心物体...")
                (setq ss1 (ssget))
              )
         )
    (progn
      (setq box        (xdrx_entity_box ss1)
            pt        (xdrx_midp (car box) (caddr box))
      )
      (setq p1 (polar pt 0. 1.)
            p2 (polar pt (* 0.5 pi) 1.)
      )
      (xdrx_begin)
      (xdrx_setmark)
      (vl-cmdf ".mirror" ss "" "_none" pt "_none" p1 "N")
      (setq s1 (xdrx_getss))
      (vl-cmdf ".mirror" ss "" "_none" pt "_none" p2 "n")
      (vl-cmdf ".mirror" s1 "" "_none" pt "_none" p2 "n")
      (xdrx_end)
    )
  )
  (princ)
)[/pcode]

Lispboy

rxing 发表于 2013-5-4 18:37

                               
登录/注册后可看大图

可否把程序改下：在选择镜像中心的时候能够选择图形，并求出图形的中心作为要镜像的中心；最后程序执行完 ...

程序执行完，再运行回下车就行了啊。

Lispboy

eachy 发表于 2013-5-4 18:59

                               
登录/注册后可看大图

重拾下API，变换就不用矩阵了(defun c:tt (/ ss ss1 s1 p1 p2 s1 box pt)
  (while (and (progn
                (princ ...

这代码看着这整洁呢，学习。

sicky111

不错，好程式。

xyp1964

2. (defun c:test550 ()
   
3.   (if (and (setq ss (ssget))
   
4.            (setq pt (getpoint "\n中心点: "))
   
5.       )
   
6.     (progn
   
7.       (setq s0 (entlast))
   
8.       (xyp-Mirror ss pt (xyp-Pt2X pt 10) nil)
   
9.       (setq ss (SSUNION (xyp-SSelEntnext s0) ss))
   
10.       (xyp-Mirror ss pt (xyp-Pt2Y pt 10) nil)
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:test550 ()<br />   (if (and (setq ss (ssget))<br />            (setq pt (getpoint "\n中心点: "))<br />       )<br />     (progn<br />       (setq s0 (entlast))<br />       (xyp-Mirror ss pt (xyp-Pt2X pt 10) nil)<br />       (setq ss (SSUNION (xyp-SSelEntnext s0) ss))<br />       (xyp-Mirror ss pt (xyp-Pt2Y pt 10) nil)<br />     )<br />   )<br />   (princ)<br /> )

金鹅起飞

不错，谢谢分享，是个好东东！

xiongqunan

这个我怎么就用不了呢！
提示：选择对象:
中心点: ; 错误: no function definition: XYP-PT2X
命令:
请高手解答一下！！！

xiongqunan

xyp1964 发表于 2013-6-12 08:42

能解决一下我用不了的问题吗？