yang686526

[求助]遍历图块中子图元时，提取子图元的点数据如何不对
www.dimcax.com
[求助]遍历图块中子图元时，提取子图元的点数据如何不对遍历图块中子图元时，提取子图元的点数据为什么不对?（在wcs下就是错误的数据）我知道一定有问题。不知道如何转换。根据cad帮且文件里说的，提取块的转换矩阵数据来进行转换，还是不对。有没有哪位大侠告知一下方法。不胜感谢！能提供一下lisp源码最好。不知各位朋友在写lisp时有没有碰到过类似的问题?
d
goto the website ownload bixform.lsp via the link below
it's the perfect reference routine that may help you.
d
問題已經解決.只是自己利用轉換矩陣轉換時有一個cadr用錯,不過還是多謝alin賜教!看來寫lisp時大家一定要小心.別少一個字母名是多一個字母的.那結果會大不同喲!
很詳細.再次感謝alin!
d
仅供参考。
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81;|功能:获得块的矩阵----支持三维-----------------
(blkmat ((car())))
|;
(
blkmat
(vobj / mxm origin ang inspt zdir xdir ydir rmat movmatrix resmatrix)
(
mxm
(m q / qt)
( qt ( 'mapcar ( 'list q)))
( '(
(x)
( '(
(y)
( '+ ( '* y x))) qt)) m)
)
(
( origin(vlax-get (vlax-invoke (vlax-get (vlax-get ()
"activedocument")
"blocks")
"item" (vlax-get vobj "name"))
"origin"))
( ang (vlax-get vobj "rotation"))
( inspt ( '- (vlax-get vobj "insertionpoint") origin));需要增加块定义原点的判断~~~~
( zdir (vlax-get vobj "normal"))
( xdir(
(
( ang)( ang)
0) zdir 0))
( ydir(
(-
(
( zdir)( xdir))
(
( zdir)( xdir)));叉乘得到y轴方向-------
(-
(
( zdir)( xdir))
(
( zdir)( xdir)))
(-
(
( zdir)( xdir))
(
( zdir)( xdir)))))
( rmat(
(
( xdir)( ydir)
( zdir)
0)
(
( xdir)( ydir)( zdir)
0)
(
( xdir)( ydir)( zdir)
0)))
( rmat( '((x y)( '((m)( m y)) x))
rmat
(
(vlax-get vobj "xscalefactor")
(vlax-get vobj "yscalefactor")
(vlax-get vobj "zscalefactor")
)))
( rmat(
( rmat)
( rmat)
( rmat) '(0 0 0 1)))
( movmatrix(
(
1 0 0
( inspt))(
0 1 0
( inspt))(
0 0 1
( inspt))
'(0 0 0 1)))
( rmat (mxm movmatrix rmat))
)
rmat
)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
(
insertmat
(insertename / insertelist zaxis
ncsxaxis insertangle tmp1 tmp2
orig
)
( zaxis (
(
210
( insertelist ( insertename))))
insertangle (
(
50 insertelist))
ncsxaxis (
(
( insertangle)
(-
( insertangle))
0.0)
(
(
210 insertelist))
0
)
orig (
'-
(vlax-get
(vla-item
(vla-get-blocks
(vla-get-activedocument
())
)
(vlax-get ( insertename) 'name)
)
'origin
)
)
)
;; set up the return value
;; the insertion point of the insert
( tmp1 (
(
(
10 insertelist)) zaxis 0))
;; the scale factors
( tmp2 (
(
(
41 insertelist))
(
(
42 insertelist))
(
(
43 insertelist))
)
)
(mxm
(
(
( '* ncsxaxis tmp2)
(
(
0 tmp1)))
(
( '* (vectorcrossproduct zaxis ncsxaxis) tmp2)
(
(
1 tmp1))
)
(
( '* zaxis tmp2)
(
(
2 tmp1)))
'(0.0 0.0 0.0 1.0)
)
(
(
1.0 0.0 0.0
( orig))
(
0.0 1.0 0.0
( orig))
(
0.0 0.0 1.0
( orig))
'(0.0 0.0 0.0 1.0)
)
)
)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
再贴一个函数：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
(
( e ( "\nselect nested pline: "))
( 4 ( e))
( obj ( ( e)))
( pt ( e))
( blklst ( e))
( pt (transpt pt blklst 1 2)) ;ucs to ocs
( pt ( obj pt))
( param ( obj pt))
( p1 ( obj ( param)))
( p2 ( obj ( ( param))))
( p1 (transpt p1 blklst 2 1)) ;ocs to ucs
( p2 (transpt p2 blklst 2 1))
( ( blklst))
( p1 p2 7 -1)
)
()
) ;end
|;
( *blocks*
( *blocks*
(vla-get-blocks
(vla-get-activedocument
()
)
)
)
)
;; argument: a block reference ename or vla-object.
;; returns: a 4x4 transformation matrix like nentselp.
( objmatrix (vobj / orig ang inspt nrml xsf
ysf zxf sclm rotm movm origm nrmlm
)
( ( ( vobj) 'ename)
( vobj ( vobj))
)
( orig (vlax-get (vla-item *blocks* (vlax-get vobj 'name)) 'origin))
( orig ( '- orig)
ang (vlax-get vobj 'rotation)
inspt (vlax-get vobj 'insertionpoint)
xsf (vlax-get vobj 'xscalefactor)
ysf (vlax-get vobj 'yscalefactor)
zsf (vlax-get vobj 'zscalefactor)
sclm (om:scalematrix xsf ysf zsf)
rotm (om:rotationmatrix ang)
movm (omointmatrix inspt)
origm (omointmatrix orig)
nrmlm (om:normalmatrix nrml)
)
(mxm movm
(mxm nrmlm
(mxm rotm
(mxm sclm origm)
)
)
)
) ;end
;; argument: a block reference ename or vla-object.
;; returns: an inverse 4x4 transformation matrix.
( inverseobjmatrix (vobj / orig ang inspt nrml
xsf ysf zxf sclm rotm movm
origm nrmlm
)
( ( ( vobj) 'ename)
( vobj ( vobj))
)
( orig (vlax-get (vla-item *blocks* (vlax-get vobj 'name)) 'origin))
( ang (- (vlax-get vobj 'rotation))
inspt ( '- (vlax-get vobj 'insertionpoint))
xsf ( 1 (vlax-get vobj 'xscalefactor))
ysf ( 1 (vlax-get vobj 'yscalefactor))
zsf ( 1 (vlax-get vobj 'zscalefactor))
sclm (om:scalematrix xsf ysf zsf)
rotm (om:rotationmatrix ang)
movm (omointmatrix inspt)
origm (omointmatrix orig)
nrmlm (om:normalmatrix nrml)
)
(mxm origm
(mxm sclm
(mxm rotm
(mxm nrmlm movm)
)
)
)
) ;end
;; arguments:
;; pt - point to transform
;; blklst - typically a list of enames returned
;; by ( nentsel) or ( nentselp)
;; from and to similar to trans: wcs = 0, ucs = 1 and ocs = 2
;; examples: (transpt point blocklist 1 2) ucs > ocs
;; (transpt point blocklist 2 0) ocs > wcs
;; returns: the transformed pt argument.
( transpt (pt blklst from to / ptmatrix matrix matrixlst res)
(
( 3 ( pt))
( pt ( pt '(0.0)))
)
(
( ( from 0) ( from 2))
( pt ( pt 1 0))
)
( ( ( to 0) ( to 1))
; to wcs or ucs
( matrixlst ( 'objmatrix blklst))
; to ocs
( matrixlst ( ( 'inverseobjmatrix blklst)))
)
( matrix ( matrixlst))
( ( ( matrixlst) 1)
( (1- ( matrixlst))
( matrix (mxm ( matrixlst) matrix))
( matrixlst ( matrixlst))
)
)
( ptmatrix (omointmatrix pt))
( matrix (mxm matrix ptmatrix))
( res
(
( ( matrix))
( ( matrix))
( ( matrix))
)
)
(
( ( to 0) ( to 2))
( res ( res 0 1))
)
res
) ;end
;; start sub-functions ;;
;; apply a transformation matrix to a vector,
;; by vladimir nesterovsky
( mxv (m v)
( '( (row) ( '+ ( '* row v))) m)
)
;; multiply two matrices, by vladimir nesterovsky.
( mxm (m q / qt)
( qt ( 'mapcar ( 'list q)))
( '( (mrow) (mxv qt mrow)) m)
)
( om:scalematrix (x y z)
(
( x 0 0 0)
( 0 y 0 0)
( 0 0 z 0)
( 0 0 0 1)
)
)
( om:rotationmatrix (a)
(
( ( a) (- ( a)) 0 0)
( ( a) ( a) 0 0)
( 0 0 1 0)
( 0 0 0 1)
)
)
( omointmatrix (p)
(
( 1 0 0 ( p))
( 0 1 0 ( p))
( 0 0 1 ( p))
( 0 0 0 1)
)
)
(
(( ( arglst) '(0.0 0.0 1.0))
(
'(1 0 0 0)
'(0 1 0 0)
'(0 0 1 0)
'(0 0 0 1)
)
)
(( ( arglst) '(0.0 0.0 -1.0))
(
'(-1 0 0 0)
'(0 1 0 0)
'(0 0 -1 0)
'(0 0 0 1)
)
)
(
(mwe:getnmatrix arglst)
)
)
)
;; the following functions by james allen calculate the
;; normal matrix when the block normal is other than
;; (0.0 0.0 1.0) or (0.0 0.0 -1.0).
;;; returns a generalized orientation matrix given a
;;; source normal vector and destination normal vector
;;;
;;; let nrm = ((i) (j) (k)) and w = ((x) (y) (z)):
;;;
;;; getomatrix returns ((pix pjx pkx 0)
;;; (piy pjy pky 0)
;;; (piz pjz pkz 0)
;;; (0 0 0 1))
;;;
;;; where, for example, pix indicates magnitude of
;;; vector i projected onto vector x
;;;
( mwe:getomatrix (arglst / nrm w)
( nrm ( 0 arglst)
w ( 1 arglst)
)
(
(
'(0 0 0 1)
(
(
'( (b)
(
( 0
(
( '( (a) (mwerojuv ( a b))) nrm)
)
)
)
)
w
)
)
)
)
)
;;; returns an ocs orientation matrix given a normal vector
( mwe:getnmatrix (arglst / nrm w)
( nrm ( 0 arglst)
nrm ( ( nrm ( (mwe:arbaxis ( nrm)))))
w '((1 0 0) (0 1 0) (0 0 1))
)
( ( 1 arglst)
( 'set '(nrm w) ( w nrm))
)
(mwe:getomatrix ( nrm w))
)
;;; arbaxis calculates the arbitrary x and resulting y axes
;;; from a given normal vector
( mwe:arbaxis (arglst / n wy wz ax l ay)
( n ( 0 arglst)
wy '(0.0 1.0 0.0)
wz '(0.0 0.0 1.0)
)
( ( ( ( ( 0 n)) ( 1.0 64))
( ( ( 1 n)) ( 1.0 64))
)
( ax (mwe:crossprod ( wy n)))
( ax (mwe:crossprod ( wz n)))
)
( l ( '(0 0 0) ax)
ax ( '( (x) ( x l)) ax)
ay (mwe:crossprod ( n ax))
l ( '(0 0 0) ax)
ay ( '( (x) ( x l)) ay)
)
( ax ay)
)
;;; calculates the cross product of two three-element vectors
( mwe:crossprod (arglst / a b)
( a ( 0 arglst)
b ( 1 arglst)
)
( (- ( ( 1 a) ( 2 b)) ( ( 2 a) ( 1 b)))
(- ( ( 2 a) ( 0 b)) ( ( 0 a) ( 2 b)))
(- ( ( 0 a) ( 1 b)) ( ( 1 a) ( 0 b)))
)
)
;;; projuv returns the magnitude of a vector u projected onto v
( mwerojuv (arglst / u v mv udv mm)
( u ( 0 arglst) ; vector u
v ( 1 arglst) ; vector v
mv ( '(0 0 0) v) ; magnitude of v
udv ( '+ ( '* u v)) ; u dot v
mm ( udv mv) ; magnitude of u projection on v
)
)
;; end sub-functions ;;
d
bixform.lsp
block-to-insert and insert-to-block coordinate transforms
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
;;; xformspec (blocktoinsertsetup insertename)
;;; )
;;;
;;; the second step is to obtain a point that you wish
;;; to transform. this point may be a point obtained
;;; from entries in the block table, or a point in the
;;; insert entity (expressed in wcs). example:
;;;
;;; ( blockname ( ( 2 ( insertename)))
;;; blockelist ( "block" blockname)
;;; firstentity ( ( ( -2 blockelist)))
;;; point1 ( ( 10 firstentity))
;;; )
;;;
;;; the final step is to transform the point. to transform
;;; a point obtained from the block table into the corresponding
;;; point in the insert entity, call blocktoinsertxform,
;;; passing the point and the return value of blocktoinsertsetup
;;; as arguments. the return value will be the corresponding
;;; point in the insert entity, expressed in wcs. example:
;;;
;;; ( point2 (blocktoinsertxform point1 xformspec))
;;;
;;; or, to transform a point (expressed in wcs) obtained from
;;; an insert entity into the corresponding point in the
;;; block table, use inserttoblockxform with the same arguments.
;;;
;;; you may repeat the second and third steps as many times as
;;; you wish.
;;; note: there are some pathological cases in which the answer
;;; is "correct" but not what you want. these routines handle
;;; negative and positive scale factors correctly. however, if the
;;; scale factors of the insert entity are not equal in magnitude,
;;; and the insert has attributes, and the attributes have not been
;;; scaled using the same scale factors as the insert entity, and
;;; you attempt to transform points such as attribute or attdef
;;; insert points, the results will not be what you expect.
;;;--------------------------------------------------------------
;;; function to transform a point obtained from a block's
;;; specification in the block table into the corresponding
;;; point in an insert of that block.
;;; arguments:
;;; p1 = a list of three reals defining a point,
;;; usually obtained from the block table.
;;; transformspec = a list of five lists, obtained
;;; from the blocktoinsertsetup
;;; function.
;;; return value: a list of three reals containing
;;; the corresponding point in the insert entity,
;;; expressed in wcs.
;;; note: this function can be fooled in pathological
;;; circumstances. if you are transforming a point obtained
;;; from an attdef entity in the block table, and the x and/or
;;; y and/or z scale factors of the block insert have been
;;; modified so their magnitudes are not all the same, but
;;; the block insert's attributes have not been similarly
;;; scaled, the returned point will be where the attribute
;;; point "should be" (based on the insert entity's scale
;;; factors) rather than where the attribute point _is_.
;;; this routine does work correctly with scale factors
;;; of different signs.
( blocktoinsertxform (p1 transformspec)
(3dtransformab
( 0 transformspec)
( 1 transformspec)
( 2 transformspec)
( 3 transformspec)
( 4 transformspec)
p1
) ;_ end 3dtransformab
) ;_ end defun
;;; function to transform a point obtained from an insert of
;;; a block intothe corresponding point in the definition
;;; of the block in the block table.
;;; arguments:
;;; p1 = a list of three reals defining a point,
;;; expressed in wcs.
;;; transformspec = a list of five lists, obtained
;;; from the blocktoinsertsetup
;;; function.
;;; return value: a list of three reals containing
;;; the corresponding point in the block table,
;;; expressed in wcs.
;;; note: this function can be fooled in pathological
;;; circumstances. if you are transforming a point obtained
;;; from an attribute entity in the insert, and the x and/or
;;; y and/or z scale factors of the block insert have been
;;; modified so their magnitudes are not all the same, but
;;; the block insert's attributes have not been similarly
;;; scaled, the returned point will be where the attdef
;;; point in the block table "should be" (based on the
;;; insert entity's scale factors) rather than where the
;;; attdef point _is_.
;;; this routine does work correctly with scale factors
;;; of different signs.
( inserttoblockxform (p1 transformspec)
(3dtransformba
( 0 transformspec)
( 1 transformspec)
( 2 transformspec)
( 3 transformspec)
( 4 transformspec)
p1
) ;_ end 3dtransformba
) ;_ end defun
;;; function to set up the transformation specification
;;; for transforming coordinates specified in an entry
;;; the block table to an insert of that block ( vice
;;; versa).
;;; argument: the entity name of an insert entity
;;; to understand the return value, first consider
;;; a coordinate system i call the natural coordinate
;;; system (ncs). the z axis of the ncs is the same as
;;; the z axis of the insert's object coordinate
;;; system (ocs). the x axis of the ncs is rotated
;;; (around the ocs z axis) from the x axis of the ocs
;;; by the amount of rotation of the insert. similarly,
;;; the ncs y axis is rotated (around the ocs z axis)
;;; from the ocs y axis by the same amount. the origin
;;; of the ncs is at the insertion point of the insert.
;;; in other words, the ncs is a coordinate system in
;;; the block is inserted at (0,0,0) with a rotation
;;; angle of zero.
;;; return value: a list of lists containing:
;;; 1. a unit vector along the x axis of the
;;; insert's ncs, expressed in world
;;; coordinate system (wcs).
;;; 2. a unit vector along the y axis of the
;;; insert's ncs, expressed in wcs.
;;; 3. a unit vector along the z axis of the
;;; insert's ncs, expressed in wcs.
;;; 4. a vector from wcs 0,0,0 to the insert
;;; point of the insert entity (the origin
;;; of the ncs), expressed in wcs.
;;; 5. a list of three reals containing the
;;; insert's x, y and z scale factors.
( blocktoinsertsetup (insertename
/
insertelist
zaxis
ncsxaxis
insertangle
)
;; get the entity association list of the insert and the z
;; axis of the ncs ( ocs)
( zaxis ( ( 210 ( insertelist ( insertename))))
;; the ocs x axis is, in ocs, '(1 0 0). the ncs x axis is
;; therefore, in ocs,
;; (( insertangle) ( insertangle) 0.0).
;; transforming this vector to wcs gives the ncs x axis in
;; wcs:
insertangle ( ( 50 insertelist))
ncsxaxis ( ( ( insertangle) ( insertangle) 0.0)
( ( 210 insertelist))
0
) ;_ end trans
) ;_ end setq
;; set up the return value
( ncsxaxis
;; the y axis of the ncs (it will be a unit vector
;; because it's the cross product of two unit
;; vectors at a right angle to each other)
(vectorcrossproduct zaxis ncsxaxis)
zaxis
;; the insertion point of the insert
( ( ( 10 insertelist)) zaxis 0)
;; the scale factors
( ( ( 41 insertelist))
( ( 42 insertelist))
( ( 43 insertelist))
) ;_ end list
) ;_ end list
) ;_ end defun
;;; vector cross product function
;;; argument: two lists, each of three real numbers defining
;;; a vector in 3-space
;;; return value: a list of three real numbers containing
;;; the first argument crossed with the second argument.
( vectorcrossproduct (inputvector1 inputvector2)
( (- ( ( inputvector1) ( inputvector2))
( ( inputvector2) ( inputvector1))
) ;_ end -
(- ( ( inputvector1) ( inputvector2))
( ( inputvector2) ( inputvector1))
) ;_ end -
(- ( ( inputvector1) ( inputvector2))
( ( inputvector2) ( inputvector1))
) ;_ end -
) ;_ end list
) ;_ end defun
;;; function to carry out an arbitrary 3d coordinate
;;; transformation from an "a" coordinate system
;;; to a "b" coordinate system. works between any two
;;; cartesian coordinates of the same handedness, and
;;; may work between cartesian coordinate systems of
;;; different handedness (with appropriate negative
;;; values in the "sa" argument).
;;; the "3dtransformba" function is the inverse of
;;; this function.
;;; arguments:
;;; xa = a list of three reals defining a unit vector
;;; pointing along the x axis of the "a" coordinate
;;; system, expressed in the "b" coordinate system
;;; ya = a list of three reals defining a unit vector
;;; pointing along the y axis of the "a" coordinate
;;; system, expressed in the "b" coordinate system
;;; za = a list of three reals defining a unit vector
;;; pointing along the z axis of the "a" coordinate
;;; system, expressed in the "b" coordinate system
;;; oa = a list of three reals defining a vector from
;;; the origin of the "b" coordinate system to the
;;; origin of the "a" coordinate system, expressed
;;; in the "b" coordinate system
;;; sa = a list of three reals defining the scale factors;
;;; "b" x axis units per "a" x axis unit, "b" y axis
;;; units per "a" y axis unit, and "b" z axis units
;;; per "a" z axis unit
;;; p1 = a list of three reals defining a point in the
;;; "a" coordinate system
;;; return value: a list of three reals defining the same
;;; point as p1, but expressed in the "b" coordinate system
( 3dtransformab (xa ya za oa sa p1 /)
;; scale the input point to "b" system units
( p1 ( '* p1 sa))
;; translate and set up the return value
( '+
oa
;; the following does the rotation transformation
( ( ( ( xa) ( p1))
( ( ya) ( p1))
( ( za) ( p1))
) ;_ end +
( ( ( xa) ( p1))
( ( ya) ( p1))
( ( za) ( p1))
) ;_ end +
( ( ( xa) ( p1))
( ( ya) ( p1))
( ( za) ( p1))
) ;_ end +
) ;_ end list
) ;_ end mapcar
) ;_ end defun
;;; function to carry out an arbitrary 3d coordinate
;;; transformation from a "b" coordinate system
;;; to an "a" coordinate system. works between any two
;;; cartesian coordinates of the same handedness, and
;;; may work between cartesian coordinate systems of
;;; different handedness (with appropriate negative
;;; values in the "sa" argument).
;;; the "3dtransformab" function is the inverse of
;;; this function.
;;; arguments:
;;; xa = a list of three reals defining a unit vector
;;; pointing along the x axis of the "a" coordinate
;;; system, expressed in the "b" coordinate system
;;; ya = a list of three reals defining a unit vector
;;; pointing along the y axis of the "a" coordinate
;;; system, expressed in the "b" coordinate system
;;; za = a list of three reals defining a unit vector
;;; pointing along the z axis of the "a" coordinate
;;; system, expressed in the "b" coordinate system
;;; oa = a list of three reals defining a vector from
;;; the origin of the "b" coordinate system to the
;;; origin of the "a" coordinate system, expressed
;;; in the "b" coordinate system
;;; sa = a list of three reals defining the scale factors;
;;; "b" x axis units per "a" x axis unit, "b" y axis
;;; units per "a" y axis unit, and "b" z axis units
;;; per "a" z axis unit
;;; p1 = a list of three reals defining a point in the
;;; "b" coordinate system
;;; return value: a list of three reals defining the same
;;; point as p1, but expressed in the "a" coordinate system
( 3dtransformba (xa ya za oa sa p1 /)
;; translate
( p1 ( '- p1 oa))
;; scale and set up the return value
( '/
;; the following does the rotation
( ( ( ( xa) ( p1))
( ( xa) ( p1))
( ( xa) ( p1))
) ;_ end +
( ( ( ya) ( p1))
( ( ya) ( p1))
( ( ya) ( p1))
) ;_ end +
( ( ( za) ( p1))
( ( za) ( p1))
( ( za) ( p1))
) ;_ end +
) ;_ end list
sa
) ;_ end mapcar
) ;_ end defun