求大大帮忙写一段简单的LISP

ysq101

求大大帮忙写一段简单的LISP


具体功能如下：




将一个对象向某一方向复制
复制方向由用户指定
复制距离为：角度*TAN*10
（不知道是不是这样表达，如1度：1*0.017455*10）
                        如5度：5*0.087488*10
然后将((复制后))的对象改为红色
应该需要改复制后的对象颜色麻烦点，可以改为：改变选定对象颜色为    蓝色




大概是这样：
：输入命令
：请指度角度
：请指定方向
：完成


      

XDSoft

贴个图片吧，要复制什么对象? 这个程序是什么专业的想实现什么？

ysq101

需要复制的对象不一定。。。一般是长方形   只是想复制多一份   距离为a*tan*10   方向自定

XDSoft

ysq101 发表于 2013-4-29 18:03

                               
登录/注册后可看大图

需要复制的对象不一定。。。一般是长方形   只是想复制多一份   距离为a*tan*10   方向自定

你这要求，这两天讨论的矩阵正好做，看看哪个朋友能用矩阵帮你写一个。

Lispboy

用高飞鸟斑竹的矩阵函数写一个，楼主测试下吧，还没考虑颜色什么的~
[pcode=lisp,true]
(vl-load-com)
(defun MAT:Translation ( v )
  (list
    (list 1. 0. 0. (car v))
    (list 0. 1. 0. (cadr v))
    (list 0. 0. 1. (caddr v))
    (list 0. 0. 0. 1.)
  )
)
(defun c:ttt( / an an1 d1 dis e i mat_t obj  ss)
   (if (and (setq ss (ssget))
            (setq an (getreal "\n输入复制的角度<退出>:"))
            (setq dis (getreal "\n输入距离<退出>:"))
       )
       (progn
          (command ".copy" ss "" '(0 0 0) '(0 0 0))
          (setq an1 (* pi (/ an 180.0)))
          (setq d1 (polar '(0 0 0) an1 (* dis an (/ (sin an)(cos an)))))
          (setq m_t (Mat:Translation d1))
          (setq i -1)
          (while (setq e (ssname ss (setq i (1+ i))))
             (setq obj (vlax-ename->vla-object e))
             (vla-transformby obj (vlax-tmatrix m_t))
           )
       )
   )
   (princ)
)
[/pcode]

ysq101

谢谢各位大大的帮助。。。。我的炫帮我解决了。。

XDSoft

ysq101 发表于 2013-4-29 20:22

                               
登录/注册后可看大图

谢谢各位大大的帮助。。。。我的炫帮我解决了。。

那把代码贴上来吧，也帮助别的需要的人。

Lispboy

给矩阵变换增加了一个Ent:transformedCopy函数。

[pcode=lisp,true]
(vl-load-com)
(defun MAT:Translation ( v )
  (list
    (list 1. 0. 0. (car v))
    (list 0. 1. 0. (cadr v))
    (list 0. 0. 1. (caddr v))
    (list 0. 0. 0. 1.)
  )
)
(defun Ent:TransformedCopy (ss mat / e i obj objs)
  (cond
    ((eq (type ss) 'PICKSET)
      (setq i -1)
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq objs (cons (vlax-ename->vla-object e) objs))
      )
    )
    ((eq (type ss) 'ENAME)
      (setq objs (list (vlax-ename->vla-object ss)))
    )
  )
  (while (setq obj (car objs))
     (vlax-invoke obj 'copy)
     (vla-transformby obj (vlax-tmatrix mat))
     (setq objs (cdr objs))
  )
  (princ)
)
(defun c:ttt( /  an an1 d1 dis e i m_t obj  ss)
   (if (and (setq ss (ssget))
            (setq an (getreal "\n输入复制的角度<退出>:"))
            (setq dis (getreal "\n输入距离<退出>:"))
       )
       (progn
          (setq an1 (* pi (/ an 180.0)))
          (setq d1 (polar '(0 0 0) an1 (* dis an (/ (sin an1)(cos an1)))))
          (setq m_t (Mat:Translation d1))
          (Ent:TransformedCopy ss m_t)
       )
   )
   (princ)
)

[/pcode]

ysq101

还是不贴了~~~~~~