本帖最后由 作者 于 2008-4-10 8:53:55 编辑
(defun >&>(>a >b);计算向量的点积----
(apply '+ (mapcar '* >a >b))
)
;|功能:自动选择所有相似的图形----
;(objsimilar (car (entsel)))|;
(defun objsimilar(ent1 / n objtype i allderiv1 entlen tmp dianji ss m tmpent par l tmplen allderiv2 tmpdianji
rdianji)
(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))
)
(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)
)
;上面获得曲线的类名,参数值,一阶导数---------------------------------
(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)
tmp(* tmp tmp)
)
(setq rdianji(mapcar '(lambda(x)(* tmp x)) dianji))
(if (equal rdianji tmpdianji 1e-3);如果要有容差的话,这里可以改变一下--
(progn;相似--------
;其实比例已经出来了,旋转角度也可以由两个向量得到,最多只要镜像就可以了--
(redraw tmpent 3)
)
)
)
)
)
)
)
)
不好意思,才想起来,任意两条线段和圆弧都是相似,,,不过上面的对于其他类型的曲线应该都可以了,镜像,旋转,缩放,,,,,,,,,,,,,,,,,,,,,,,
谢谢<strong><font color="#0000ff">，</font></strong>请问怎么转化啊？
<p>有些难度啊。</p><p>有的符号什么的不是一企图产远啊，有的符号是两种图元做出来的，这种在程序中怎么判别呢？如果是线的话还好弄些。</p><p>希望看到高手的解决方案。</p>
;|功能:自动选择所有相似的图形并生成块----对于线段和弧形还有圆可能不能很好的支持,需要另外判断-----
;(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))))
)
)
为什么每行前面打 ";" ?
<p><strong><font face="Verdana" color="#61b713">xxsheng先生,您好!</font></strong></p><p><strong><font face="Verdana" color="#61b713">能否请您做成lsp,运行的命令是什么呀?怎么用不起来?</font></strong></p>
无痕发表于2008-4-11 13:42:00static/image/common/back.gif为什么每行前面打 \";\" ?
<p></p>好象是浏览器的问题。如果不是微软的浏览器，发贴就会这样。
请问怎么用啊?
<p>太厉害了........</p><p>正在漫漫研究..</p><p></p><p></p>