- 积分
- 2190
- 明经币
- 个
- 注册时间
- 2005-5-4
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2008-4-11 10:01:00
|
显示全部楼层
 - ;|功能:自动选择所有相似的图形并生成块----对于线段和弧形还有圆可能不能很好的支持,需要另外判断-----
- ;(objsimilar (car (entsel)))
- 觉得实用性好像不是很强~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 还有一个就是如果曲线的前三个顶点在同一个直线上的话,可能不能正确的判断镜像---
- |;
- (defun objsimilar(ent1 / n objtype i allderiv1 entlen adwg blks spoint npoint blkname blkdef mspace tmp dianji 1ofent1
-                  ss m tmpent par l allderiv2 tmplen tmpdianji tmp2 rdianji insp tmpp2 1ofent2 zdir ang tmpblkref
-                  mat threep tmpthreep tmpdir rdir)
-   (setq n(fix(- (vlax-curve-getendParam ent1) (vlax-curve-getStartParam ent1)))
-     objtype(cdr(assoc 0 (entget ent1)))
-     i -1 allderiv1 nil
-     entlen (vlax-curve-getDistAtParam ent1 (vlax-curve-getendparam ent1))
-     adwg(vlax-get (vlax-get-acad-object) "Activedocument")
-     blks(vlax-get adwg "blocks")
-     spoint(vlax-curve-getStartPoint ent1)
-     npoint(vlax-curve-getPointatparam ent1 1)
-     blkname(getvar "tdusrtimer")
-     blkdef(vlax-invoke blks 'add spoint blkname)
-     mspace(vlax-get adwg "modelspace")
-     )
-   (vlax-invoke adwg 'copyobjects (list (vlax-ename->vla-object ent1)) blkdef);生成块-----
-   (while (<= (setq i(1+ i)) n)
-     (setq allderiv1(cons (vlax-curve-getFirstDeriv ent1 i) allderiv1))
-   )
-   (setq tmp (car allderiv1)
-     dianji(mapcar '(lambda(x)(>&> x tmp)) allderiv1)
-     1ofent1(->1ofa (>-> npoint spoint))
-   )
-   ;上面获得曲线的类名,参数值,一阶导数---------------------------------如果只有两个点的话-
-   (if (and (setq ss(ssget "x" (list (cons 0 objtype))))
-        (setq ss(ssdel ent1 ss))
-        (setq m(sslength ss))
-       )
-     (progn
-       (setq i -1)
-       (while (<(setq i(1+ i))m)
-     (setq tmpent(ssname ss i))
-     (if(= n (setq par(fix(- (vlax-curve-getendParam tmpent)(vlax-curve-getStartParam tmpent)))))
-       (progn
-         (setq l -1 allderiv2 nil tmplen(vlax-curve-getDistAtParam tmpent (vlax-curve-getendparam tmpent)))
-         (while (<= (setq l(1+ l)) n)
-           (setq allderiv2(cons (vlax-curve-getFirstDeriv tmpent l) allderiv2)))
-         (setq tmp (car allderiv2)
-           tmpdianji(mapcar '(lambda(x)(>&> x tmp)) allderiv2)
-           )
-         (setq tmp (/ tmplen entlen)
-           tmp2(* tmp tmp)
-           )
-         (setq rdianji(mapcar '(lambda(x)(* tmp2 x)) dianji))
-         (if (equal rdianji tmpdianji 1e-3);如果要有容差的话,这里可以改变一下--
-           (progn;相似--------
-         ;其实比例已经出来了,旋转角度也可以由两个向量得到,最多只要镜像就可以了--
-         (redraw tmpent 3)
-         (setq insp(vlax-curve-getStartPoint tmpent)
-               tmpp2(vlax-curve-getPointatparam tmpent 1)
-               )
-         (setq 1ofent2(->1ofa (>-> tmpp2 insp)))
-         (setq zdir(>*> 1ofent1 1ofent2))
-         (setq ang(acos (>&> 1ofent1 1ofent2)))
-         (if (equal '(0 0 0) zdir 1e-3);两向量平行或者反向,---------------------
-           (setq tmpblkref(vlax-invoke mspace 'InsertBlock insp
-                        blkname tmp tmp tmp ang))
-           (progn
-             (setq tmpblkref(vlax-invoke mspace 'InsertBlock insp
-                        blkname tmp tmp tmp 0))
-             (setq mat(rotatemat insp (mapcar '+ zdir insp) ang))
-             (vla-transformby tmpblkref (vlax-tmatrix mat))
-           )
-           ;;上面解决了绕Z轴旋转的问题------------------------------------------
-         )
-         ;;下面解决镜像和三维旋转的问题-----------------------------------------
-         (if (> n 2);只有当段数大于2的时候也就是至少三个点的时候才进行判断镜像--
-           (progn
-             ;;首先进行原来线段的前两个向量的叉乘--
-             ;;再进行新线段的前两个向量的叉乘------
-             ;;求两个叉乘的法向量,并且得到角度-----
-             ;;然后旋转该角度----------------------
-             (setq threep(vlax-curve-getPointatparam ent1 2)
-               threep(>-> threep spoint)
-               tmpthreep(>-> (vlax-curve-getPointatparam tmpent 2) insp)
-               zdir(->1ofa(>*> 1ofent1 threep))
-               tmpdir(->1ofa(>*> 1ofent2 tmpthreep))
-               rdir(>*> zdir tmpdir)
-               ang(acos (>&> zdir tmpdir))
-               )
-             (if (equal '(0 0 0) rdir 1e-3);两向量平行或者反向,---------------------
-               (progn
-             (if (< (>&> zdir tmpdir) 0)
-               (progn
-                 (setq mat(rotatemat insp tmpp2 pi))
-                 (vla-transformby tmpblkref (vlax-tmatrix mat)))
-             )
-               )
-               (progn
-             (setq mat(rotatemat insp (mapcar '+ rdir insp) ang))
-             (vla-transformby tmpblkref (vlax-tmatrix mat))
-               )
-             )
-           )
-         )
-         ;上面创建块完毕,可以直接进行删除原来的图元---------------------------
-         ;(entdel tmpent)
-           )
-         )
-       )
-     )
-       )
-     )
-   )
- )
- ;;定义向量的减法>->
- (defun >->(>a >b)
-   (mapcar '- >a >b)
- )
- (defun ->1ofa(>a / |a|);对零向量未加判断-----------------
-   (setq |a|(/ 1 ((sqrt(apply '+ (mapcar '* >a >a))))))
-   (mapcar '(lambda(y)(* y |a|)) >a)
- )
- ;;定义向量的数性积>&>
- (defun >&>(>a >b)
-   (apply '+ (mapcar '* >a >b))
- )
- ;|旋转矩阵----
- 罗德里格斯旋转公式:
- T(v)=(r&> (cos 0.785398) v)+(r&> (sin 0.785398) (>*> u v))+(r&> (* (- 1 (cos 0.785398))(>&> u v)) u)
- (>+> (r&> (cos 0.785398) v)(>+> (r&> (sin 0.785398) (>*> u v)) (r&> (* (- 1 (cos 0.785398))(>&> u v)) u)))
- 参数一为旋转轴的起点,可以为nil,则起点为'(0 0 0)
- 参数二为旋转轴的端点,如果第一个参数为nil,则本参数代表旋转轴的方向向量--
- 参数三为旋转角度---------
- (rotatemat '(1 2 3) '(5 5 5) pi)
- |;
- (defun rotatemat(sp ep ang / ->1of i cosv sinv antimat t1 t2 t3)
-   (if sp
-     (setq ->1of(->1ofa (mapcar '- ep sp)))
-     (setq ->1of(->1ofa ep))
-   )
-   (setq cosv(cos ang)
-     sinv(sin ang)
-     antimat(antisymmetricmatof-> ->1of)
-     t1(list (list cosv 0 0)(list 0 cosv 0)(list 0 0 cosv))
-     t2(r*mat (- 1 cosv) (>@> ->1of nil))
-     t3(r*mat sinv antimat)
-     t1(mat+mat t1 t2)
-     t1(mat+mat t1 t3)
-     )
-   (if (->zerop sp)
-     (list (list (car(car t1))(cadr(car t1))(caddr(car t1)) 0)
-       (list (car(cadr t1)) (cadr(cadr t1))(caddr(cadr t1))0)
-       (list (car(caddr t1))(cadr(caddr t1))(caddr(caddr t1))0)
-       '(0 0 0 1))
-     (progn
-       (setq sp(>-> sp (mapcar '(lambda(x)(>&> x sp)) t1)))
-       (list (list (caar t1)(cadar t1)(caddar t1) (car sp))
-         (list (caadr t1)(cadadr t1)(caddr(cadr t1)) (cadr sp))
-         (list (caaddr t1)(cadr(caddr t1))(caddr(caddr t1)) (caddr sp))
-         '(0 0 0 1))
-     )   
-   )
- )
- ;|定义向量的等价反对称矩阵-----------------------------
- (antisymmetricmatof-> '(1 2 3));返回:((0 -3 2) (3 0 -1) (-2 1 0))
- |;
- (defun antisymmetricmatof->(->a / a b c)
-   (setq a(car ->a)
-     b(cadr ->a)
-     c(caddr ->a))
-   (list (list 0 (- c) b)
-     (list c 0 (- a))
-     (list (- b) a 0)
-     )
- )
- ;|功能:定义向量的张量积--<计算机图形学几何工具算法详解 P105>
- (>@> '(1 0 0) '(1 0 0))
- 就是矩阵相乘:(mat*mat '((1) (0) (0)) '((1 0 0)))
-              (mat*mat (transposed (list ->a)) (list ->b))
- 返回:((1 0 0) (0 0 0) (0 0 0))
- (>@> '(4 5 2) '(1 3 2));返回:((4 12 8) (5 15 10) (2 6 4))
- |;
- (defun >@>(->a ->b / tmp)
-   (if (null ->b)(setq ->b ->a))
-   (mapcar '(lambda(x)(mapcar '(lambda(y)(* x y)) ->b)) ->a)
- )
- ;;定义数乘矩阵------------------------------------
- ;;(r*mat 5 '((1 2 3 100)(4 5 6 200)(7 8 9 300)(10 11 12 400)))
- (defun r*mat(r mat)
-   (mapcar '(lambda(x)(mapcar '(lambda(y)(* r y)) x))mat)
- )
- ;;定义矩阵的相加----------------------------------
- (defun mat+mat(lst1 lst2)
-   (mapcar '(lambda(x y)(mapcar '(lambda(m n)(+ m n)) x y)) lst1 lst2)
- )
- ;;定义向量的叉乘>*>
- ;;叉乘得到的向量的意义:方向与>a和>b均垂直,
- ;;且使(>a >b (>*> >a >b))成右手系--------
- ;;几何意义：叉乘的模等于以两向量为邻边的平行四边形的面积-
- (defun >*>(>a >b)
-      (list (- (* (cadr >a)(caddr >b)) (* (caddr >a)(cadr >b)))
-        (- (* (caddr >a)(car >b)) (* (car >a)(caddr >b)))
-        (- (* (car >a)(cadr >b)) (* (cadr >a)(car >b))))
-     )
- )
|
|
[复制链接]
显身卡
楼主
发表于 2008-4-11 18:40:00
