[LISP程序]：使用grread函数的动态翻转程序

841594 · 发表于 2004-4-27 21:18:41

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

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

×

这个程序的功能是对选中的物体围绕指定点进行旋转、镜像操作。
程序以指定点为中心分成8个区域，在区域间滑动鼠标可以动态显示翻转的状态。

[FONT=courier new]
;;;DRot.LSP
;;; v0.90 - 2004.3.18 自由翻转，是一个子程序，可以用在其他的程序中。
(defun c:drot (/ PT0 ss)
(defun drot (ss pt0 / ANG GD MR OMR ORTANG PT RTANG)
(setvar "osmode" 0)
(setvar "highlight" 0)
(setvar "mirrtext" 1)
(setq ortang 0.0
omr 0
)
(setq gd (grread t 8))
(while (= 5 (car gd))
(cond
((= 5 (car gd))
(setq pt (cadr gd)
ang (angle pt0 pt)
)
(cond
((<= 0 ang (* 0.25 pi))
(setq rtang 0.0
mr 0
)
)
((<= (* 0.25 pi) ang (* 0.5 pi))
(setq rtang 90.0
mr 1
)
)
((<= (* 0.5 pi) ang (* 0.75 pi))
(setq rtang 90.0
mr 0
)
)
((<= (* 0.75 pi) ang (* 1.0 pi))
(setq rtang 180.0
mr 1
)
)
((<= (* 1.0 pi) ang (* 1.25 pi))
(setq rtang 180.0
mr 0
)
)
((<= (* 1.25 pi) ang (* 1.5 pi))
(setq rtang 270.0
mr 1
)
)
((<= (* 1.5 pi) ang (* 1.75 pi))
(setq rtang 270.0
mr 0
)
)
((<= (* 1.75 pi) ang (* 2.0 pi))
(setq rtang 0.0
mr 1
)
)
(1)
)
(cond
((and (/= ortang rtang) (/= omr mr))
(command
"mirror"
ss
""
pt0
(polar pt0 (* pi (/ (* 0.5 (+ rtang ortang)) 180.0)) 1.0)
"y"
)
)
((/= ortang rtang)
(command "rotate" ss "" pt0 (- rtang ortang))
)
((/= mr omr)
(command "mirror"
ss
""
pt0
(polar pt0 (* pi (/ rtang 180.0)) 1.0)
"y"
)
)
)
(setq ortang rtang
omr mr
)
)
(1)
) ;cond
(setq gd (grread t 8))
) ;while
)
;;; main
(prompt "\n请选择要翻转的实体: ")
(if (and (setq ss (ssget))
(setq pt0 (getpoint "\n翻转基点: "))
)
(drot ss pt0)
) ;if
(princ)
) ;
[/FONT]

[FONT=courier new] 
;;;DRot.LSP 
;;;        v0.90 - 2004.3.18        自由翻转，是一个子程序，可以用在其他的程序中。 
 
(defun c:drot (/ PT0 ss) 
 
  (defun drot (ss pt0 / ANG GD MR OMR ORTANG PT RTANG) 
    (setvar "osmode" 0) 
    (setvar "highlight" 0) 
    (setvar "mirrtext" 1) 
    (setq ortang 0.0 
          omr 0 
    ) 
    (setq gd (grread t 8)) 
    (while (= 5 (car gd)) 
      (cond 
        ((= 5 (car gd)) 
         (setq pt  (cadr gd) 
               ang (angle pt0 pt) 
         ) 
         (cond 
           ((<= 0 ang (* 0.25 pi)) 
            (setq rtang        0.0 
                  mr 0 
            ) 
           ) 
           ((<= (* 0.25 pi) ang (* 0.5 pi)) 
            (setq rtang        90.0 
                  mr        1 
            ) 
           ) 
           ((<= (* 0.5 pi) ang (* 0.75 pi)) 
            (setq rtang        90.0 
                  mr        0 
            ) 
           ) 
           ((<= (* 0.75 pi) ang (* 1.0 pi)) 
            (setq rtang        180.0 
                  mr        1 
            ) 
           ) 
           ((<= (* 1.0 pi) ang (* 1.25 pi)) 
            (setq rtang        180.0 
                  mr        0 
            ) 
           ) 
           ((<= (* 1.25 pi) ang (* 1.5 pi)) 
            (setq rtang        270.0 
                  mr        1 
            ) 
           ) 
           ((<= (* 1.5 pi) ang (* 1.75 pi)) 
            (setq rtang        270.0 
                  mr        0 
            ) 
           ) 
           ((<= (* 1.75 pi) ang (* 2.0 pi)) 
            (setq rtang        0.0 
                  mr 1 
            ) 
           ) 
           (1) 
         ) 
 
         (cond 
           ((and (/= ortang rtang) (/= omr mr)) 
            (command 
              "mirror" 
              ss 
              "" 
              pt0 
              (polar pt0 (* pi (/ (* 0.5 (+ rtang ortang)) 180.0)) 1.0) 
              "y" 
            ) 
           ) 
           ((/= ortang rtang) 
            (command "rotate" ss "" pt0 (- rtang ortang)) 
           ) 
           ((/= mr omr) 
            (command "mirror" 
                     ss 
                     "" 
                     pt0 
                     (polar pt0 (* pi (/ rtang 180.0)) 1.0) 
                     "y" 
            ) 
           ) 
         ) 
         (setq ortang rtang 
               omr    mr 
         ) 
        ) 
        (1) 
      )                                        ;cond 
      (setq gd (grread t 8)) 
    )                                        ;while 
  ) 
 
;;;  main 
 
  (prompt "\n请选择要翻转的实体: ") 
  (if (and (setq ss (ssget)) 
           (setq pt0 (getpoint "\n翻转基点: ")) 
      ) 
    (drot ss pt0) 
  )                                        ;if 
  (princ) 
)                                        ; 
 
 
 
  [/FONT]

陌生人 · 发表于 2004-4-27 21:32:19

为什么没有拷贝程序段到剪贴板的按钮了？

aeo · 发表于 2004-4-27 22:34:38

(ssget)受不了吧，我才敢用entsel一个实体。

陌生人 · 发表于 2004-6-18 23:08:33

虽然我不怎么用的上（也许对其它专业很有用），但的确是挺有意思的一个程序

雪山飞狐(lzh) · 发表于 2004-6-18 23:55:43

不错，不错，为什么VBA里没有grread呢，郁闷，看样子要改行学Lisp了:）

841594 · 发表于 2004-6-19 01:11:53

最初由陌生人发布
[B]虽然我不怎么用的上（也许对其它专业很有用），但的确是挺有意思的一个程序 [/B]

写这个程序的初衷在于建筑上的应用：住宅的户型平面布置图。其特点是需要大量插入或拷贝图块，图块经常需要旋转、镜像（延正交轴或45度斜轴），用这个程序可以省去大量低级的重复劳动。陌生人应当用得上的：）
这个程序还能进一步改进，加入拷贝功能，拷贝、旋转、镜像合一，又能实地预览，应该很不错的，哪位出手改一下？

lijiao · 发表于 2004-6-19 07:49:56

最初由 841594 发布
[B]
写这个程序的初衷在于建筑上的应用：住宅的户型平面布置图。其特点是需要大量插入或... [/B]

程序的构思不错，值得奖励。
有三点建议：
1、要设置错误处理程序，加入UNDO，加入对CMDECHO变量的设置。
2、GRREAD时，要有提示，否则，会让用户不知所措。
3、在屏幕上最好要显示你划分的区域，可以用GRDRAW。
仅供参考。

wkai · 发表于 2004-6-20 08:31:42

如果能够模仿MYIE中的鼠标动作来操作的话会更加方便。
大家商议一下有没有可能实现。

陌生人 · 发表于 2004-6-20 11:08:24

最初由 841594 发布
[B]
写这个程序的初衷在于建筑上的应用：住宅的户型平面布置图。其特点是需要大量插入或... [/B]

我一般是打开极轴，也还方便。：）

myie是浏览器的myie么？我没装，能抓个动画下来看看它的鼠标是怎么神奇么？

wkai · 发表于 2004-6-20 17:45:42

看看这个
http://www.myie2.com/html_chs/tour/02mousegesture.htm

leeyuan · 发表于 2007-12-7 20:11:20

楼主有没有优化版呀

pengfei2010 · 发表于 2013-5-27 19:35:31

正在寻找这方面的资料呢。。谢谢楼主

GTJ116600 · 发表于 2013-5-29 12:38:39

呵呵，好贴。研究研究

GTJ116600 · 发表于 2013-5-29 13:08:05

好程序，收藏了。谢谢楼主

清风明月10 · 发表于 2013-5-29 18:59:42

谢谢楼主的分享！收藏备用。

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

[LISP程序]：使用grread函数的动态翻转程序

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

相关帖子