求点绕两点形成的轴旋转一角度之后坐标

kkq0305 · 发表于 2021-6-7 20:50

本帖最后由 kkq0305 于 2021-6-8 01:52 编辑

函数名rotpt
参数
pt1 被旋转的三维点
pt2 pt3 两点轴
ang 弧度旋转角度

<blockquote>(defun rotpt (pt1 pt2 pt3 ang / k axl pedpt vecped1 n f vecped2)

kkq0305 · 发表于 2021-6-8 01:55

于2021.6.8 2点修改
演示
(setq pt1 '(989 -2384 99) pt2 '(331 -1550 503) pt3 '(1142 -1970 0) ang (* 0.5 pi))
(rotpt pt1 pt2 pt3 (- ang)) 》(902.398 -1973.19 -383.649)

kkq0305 · 发表于 2021-6-8 01:55

本帖最后由 kkq0305 于 2021-6-8 02:21 编辑

(defun rotpt (pt1 pt2 pt3 ang / k axl pedpt vecped1 an f vecped2 fnorm)
  (setq       k       (/ (apply '+
                        (mapcar '* (mapcar '- pt1 pt2) (mapcar '- pt3 pt2))
               )
               (apply '+
                        (mapcar '(lambda (x) (expt x 2)) (mapcar '- pt3 pt2))
               )
            )
      axl       (mapcar '- pt3 pt2)
      pedpt       (mapcar '+ pt2 (mapcar '* (list k k k) (mapcar '- pt3 pt2)))
      vecped1       (mapcar '- pt1 pedpt)
      an       -1
      f       (lambda       (x n)
               (setq c -1)
               (apply 'append
                     (mapcar '(lambda (a)
                                 (if       (/= (setq c (1+ c)) n)
                                    (list a)
                                 )
                              )
                              x
                     )
               )
            )
      fnorm (lambda (x) (apply '+ (mapcar '* x x)))
      vecped2       (mapcar
               '(lambda (x)
                  (apply
                     '+
                     (mapcar '*
                           x
                           (list (cos ang) (sin ang) (- 1 (cos ang)))
                     )
                  )
               )
               (mapcar
                  '(lambda (x y)
                     (list
                     x
                     (if (= (setq an (1+ an)) 1)
                        (- (apply '-
                                 (mapcar '*
                                          (f axl an)
                                          (reverse (f vecped1 an))
                                 )
                           )
                        )
                        (apply '-
                              (mapcar '*
                                       (f axl an)
                                       (reverse (f vecped1 an))
                              )
                        )
                     )
                     (* y (apply '+ (mapcar '* vecped1 axl)))
                     )
                  )
                  vecped1
                  axl
               )
            )
  )
  (mapcar '+ (mapcar '(lambda (x) (* x (expt (/ (fnorm vecped1) (fnorm vecped2)) 0.5))) vecped2) pedpt)
)

guosheyang · 发表于 2021-6-8 07:02

kkq0305 发表于 2021-6-8 01:55
(defun rotpt (pt1 pt2 pt3 ang / k axl pedpt vecped1 an f vecped2 fnorm)
(setq k (/ ...

不错不错！现在正确了

USER2128 · 发表于 2021-8-14 14:59

本帖最后由 USER2128 于 2021-8-14 15:01 编辑

楼主的程序是有问题的，刚好要用到，因而花时间编了一个:

;;; 求点绕两点形成的轴旋转一角度之后坐标（lisp方式，适应3d，WCS及UCS）
;;; 原作者 HLCAD.
;ie:
; (mapcar 'set '(ptx pt2 pt3)(list(getpoint"\n测点:")(getpoint"\n轴1:")(getpoint"\n轴2:")))
; (HL:RotPt ptx pt2 pt3 (* pi(/ 133 180.0)))
(defun HL:RotPt (ptx pt2 pt3 ang / PT1 PTV RTN RTN1 VVV VX VY X0 Y0)
(setq vvv (mapcar '- pt3 pt2))
(setq pt1 (mapcar '- ptx pt2))
(setq ptv (trans pt1 0 vvv))
(mapcar 'set '(Vx Vy) ptv)
(setq x0 (- (* Vx (cos ang)) (* Vy (sin ang))))
(setq y0 (+ (* Vx (sin ang)) (* Vy (cos ang))))
(mapcar '+ (trans (list x0 y0 (caddr ptv)) vvv 0) pt2)
)

tigcat · 发表于 2021-8-14 16:00

USER2128 发表于 2021-8-14 14:59
楼主的程序是有问题的，刚好要用到，因而花时间编了一个:

感谢发现问题后分享，支持一下！

guosheyang · 发表于 2021-8-14 20:51

USER2128 发表于 2021-8-14 14:59
楼主的程序是有问题的，刚好要用到，因而花时间编了一个:

好简洁的代码,牛！

guosheyang · 发表于 2021-8-14 21:24

对头  递归哥的代码在当旋转轴的两点在wcs的xy平面，旋转点也在此平面时候会出错
   “”忽略倾斜、不按统一比例缩放的对象。
   忽略倾斜、不按统一比例缩放的对象。参数太多“”

kkq0305 · 发表于 2021-8-14 23:21

guosheyang 发表于 2021-8-14 21:24
对头递归哥的代码在当旋转轴的两点在wcs的xy平面，旋转点也在此平面时候会出错
“”忽略倾 ...

之前写的代码有问题是吧我看看

账号		自动登录	找回密码
密码			注册

[函数] 求点绕两点形成的轴旋转一角度之后坐标

评分

评分