- ;;;■=========点的坐标从世界坐标变换至对象坐标=========
- ;;;参数(<表>点 <图元名>对象)=======
- ;;;-----返回值:<表>新点坐标
- (defun trans-ucs-w->obj (in_pt in_obj / pt m_ret xu yu zu angu xp yp zp x1 y1 z1 x y z ent_obj )
- (if (and in_pt in_obj )
- (progn
- (setq ent_obj (entget in_obj))
- (setq pt (cdr(assoc '10 ent_obj)))
- (setq xu (car pt))
- (setq yu (cadr pt))
- (setq zu (caddr pt))
- (setq angu (cdr(assoc '50 ent_obj)))
- (setq xp (car in_pt))
- (setq yp (cadr in_pt))
- (setq zp (caddr in_pt))
- (setq x1 (- xp xu))
- (setq y1 (- yp yu))
- (setq z1 (- zp zu))
- (setq x (+ (* x1 (cos angu)) (* y1 (sin angu))))
- (setq y (- (* y1 (cos angu)) (* x1 (sin angu))))
- (setq z z1)
- (setq m_ret (list x y z))
- ))
- m_ret
- )
- ;;;■=========点的坐标从对象坐标变换至世界坐标=========
- ;;;参数(<表>点 <图元名>对象)=======
- ;;;-----返回值:<表>新点坐标
- (defun trans-ucs-obj->w (in_pt in_obj / pt m_ret xu yu zu angu xp yp zp x1 y1 z1 x y z )
- (if (and in_pt in_obj )
- (progn
- (setq pt (trans-ucs-w->obj '(0.0 0.0 0.0) in_obj))
- (setq xu (car pt))
- (setq yu (cadr pt))
- (setq zu (caddr pt))
- (setq angu (* -1.0 (cdr(assoc '50 (entget in_obj)))))
- (setq xp (car in_pt))
- (setq yp (cadr in_pt))
- (setq zp (caddr in_pt))
- (setq x1 (- xp xu))
- (setq y1 (- yp yu))
- (setq z1 (- zp zu))
- (setq x (+ (* x1 (cos angu)) (* y1 (sin angu))))
- (setq y (- (* y1 (cos angu)) (* x1 (sin angu))))
- (setq z z1)
- (setq m_ret (list x y z))
- ))
- m_ret
- )
来明经混了两个月了,得到了很多帮助,自己也写了不少代码!今天发上来一个自己重写的坐标变换函数,欢迎大家使用,指正! 个人感觉比较方便,不需要设置新坐标系就可以执行变换,只要传入对象名,既可以自动变换并输出对象坐标系下的新坐标,同时不影响当前ucs。trans-ucs-w->obj 与trans-ucs-obj->w 两个函数互为逆向操作,前者变换至对象坐标,后者由对象坐标变回到世界坐标。今后还会多多发源码的!
该贴已经同步到 蔡__洛的微博 |