[编程交流] 初学者-跨坐标

(defun c:Test ()
 (setq  pt1 (getpoint "\nINSERTION POINT:"))
 (setq  pt2 (getpoint pt1 "\nDIRECTION POINT:"))
 (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 11) (70 . 0) (43 . 0) (38 . 0) (39 . 0) (10 0.000000000007162 30.16249999999849) (40 . 0) (41 . 0) (42 . 0) (10 29.10812500003173 30.16249999999849) (40 . 0) (41 . 0) (42 . 0.414213562373012) (10 46.65000000014153 47.7043749999991) (40 . 0) (41 . 0) (42 . 0) (10 46.65000000014153 50.79999999999684) (40 . 0) (41 . 0) (42 . 0) (10 80.35000000009111 50.79999999999684) (40 . 0) (41 . 0) (42 . 0) (10 80.35000000009111 47.7043749999991) (40 . 0) (41 . 0) (42 . 0.414213562373175) (10 97.89187500020076 30.16249999999849) (40 . 0) (41 . 0) (42 . 0) (10 126.9999999999926 30.16249999999849) (40 . 0) (41 . 0) (42 . 0) (10 126.9999999999926 -30.16249999999168) (40 . 0) (41 . 0) (42 . 0) (10 0.000000000007162 -30.16249999999168) (40 . 0) (41 . 0) (42 . 0) (10 0.000000000007162 30.16249999999849) (40 . 0) (41 . 0) (42 . 0)))
 (command "MOVE" "L" "" "0,0,0" PT1)
 (command "rotate" "l" "" pt1 pt2)
 (princ))

(command "MOVE" "L" "" [color=magenta](trans '(0 0 0) 0 1)[/color] PT1)

(command "rotate" "l" "" [color=magenta]pt1 (* (/ (angle (trans pt1 1 0) (trans pt2 1 0)) pi) 180)[/color])

(defun unit ( v )
 (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(defun v^v ( u v )
 (list
   (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
   (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
   (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
 )
)
(defun transptucs ( pt p1 p2 p3 / ux uy uz )
 (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
 (setq ux (unit (mapcar '- p2 p1)))
 (setq uy (unit (mapcar '- p3 p1)))
 
 (mxv (list ux uy uz) (mapcar '- pt p1))
)
(defun entmakelwpoly3dpts ( ptlst aalst opclflag / ux uy uz uptlst )
 (setq uz (unit (v^v (mapcar '- (cadr ptlst) (car ptlst)) (mapcar '- (caddr ptlst) (car ptlst)))))
 (setq ux (if (equal uz '(0.0 0.0 1.0) 1e- '(1.0 0.0 0.0) (unit (v^v '(0.0 0.0 1.0) uz))))
 (setq uy (unit (v^v uz ux)))
 (setq uptlst (mapcar '(lambda ( p ) (transptucs p '(0.0 0.0 0.0) ux uy)) ptlst))
 (entmake 
   (append
     (list
       '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
       (cons 90 (length uptlst))
       (cons 70 opclflag)
       (cons 38 (caddar uptlst))
     )
     (apply 'append (mapcar '(lambda (x y) (list (list 10 (car x) (cadr x)) (cons 42 y))) uptlst aalst))
     (list (cons 210 uz))
   )
 )
 (princ)
)
(defun c:Test ( / pt1 pt2 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 plst alst )
 (setq  pt1 (getpoint "\nINSERTION POINT:"))
 (setq  pt2 (getpoint pt1 "\nDIRECTION POINT:"))
 (setq p1 (list 0.000000000007162 30.16249999999849) p2 (list 29.10812500003173 30.16249999999849) p3 (list 46.65000000014153 47.7043749999991) p4 (list 46.65000000014153 50.79999999999684) p5 (list 80.35000000009111 50.79999999999684) p6 (list 80.35000000009111 47.7043749999991) p7 (list 97.89187500020076 30.16249999999849) p8 (list 126.9999999999926 30.16249999999849) p9 (list 126.9999999999926 -30.16249999999168) p10 (list 0.000000000007162 -30.16249999999168))
 (setq a1 0.0 a2 0.414213562373012 a3 0.0 a4 0.0 a5 0.0 a6 0.414213562373175 a7 0.0 a8 0.0 a9 0.0 a10 0.0)
 (setq plst (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10))
 (setq alst (list a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
 (setq plst (mapcar '(lambda (x) (trans x 1 0)) plst))
 (entmakelwpoly3dpts plst alst 1)
 (command "move" "l" "" "0,0,0" pt1)
 (command "rotate" "l" "" pt1 pt2)
 (princ)
)

(defun unit ( v )
 (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)
(defun v^v ( u v )
 (list
   (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
   (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
   (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
 )
)
(defun WCS->UCS ( ss / xd yd zd o mat n ent entA ) (vl-load-com)
 (setq xd (getvar 'ucsxdir))
 (setq yd (getvar 'ucsydir))
 (setq zd (unit (v^v xd yd)))
 (setq o (trans '(0.0 0.0 0.0) 1 0))
 (setq mat
   (list
     (list (car xd) (car yd) (car zd) (car o))
     (list (cadr xd) (cadr yd) (cadr zd) (cadr o))
     (list (caddr xd) (caddr yd) (caddr zd) (caddr o))
     (list 0.0 0.0 0.0 1.0)
   )
 )
 (repeat (setq n (sslength ss))
   (setq ent (ssname ss (setq n (1- n))))
   (setq entA (vlax-ename->vla-object ent))
   (vla-transformby entA (vlax-tmatrix mat))
 )
 (princ)
)
(defun c:Test ( / pt1 pt2 )
 (setq  pt1 (getpoint "\nINSERTION POINT:"))
 (setq  pt2 (getpoint pt1 "\nDIRECTION POINT:"))
 (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 11) (70 . 1) (43 . 0) (38 . 0) (39 . 0) (10 0.000000000007162 30.16249999999849) (40 . 0) (41 . 0) (42 . 0) (10 29.10812500003173 30.16249999999849) (40 . 0) (41 . 0) (42 . 0.414213562373012) (10 46.65000000014153 47.7043749999991) (40 . 0) (41 . 0) (42 . 0) (10 46.65000000014153 50.79999999999684) (40 . 0) (41 . 0) (42 . 0) (10 80.35000000009111 50.79999999999684) (40 . 0) (41 . 0) (42 . 0) (10 80.35000000009111 47.7043749999991) (40 . 0) (41 . 0) (42 . 0.414213562373175) (10 97.89187500020076 30.16249999999849) (40 . 0) (41 . 0) (42 . 0) (10 126.9999999999926 30.16249999999849) (40 . 0) (41 . 0) (42 . 0) (10 126.9999999999926 -30.16249999999168) (40 . 0) (41 . 0) (42 . 0) (10 0.000000000007162 -30.16249999999168) (40 . 0) (41 . 0) (42 . 0)))
 (WCS->UCS (ssadd (entlast)))
 (command "move" "l" "" "0,0,0" pt1)
 (command "rotate" "l" "" pt1 pt2)
 (princ)
)