infipse 发表于 2022-7-6 07:28:57

初学者-跨坐标

大家好，
我用entmake制作了一个lisp来绘制一些东西。这个lisp在世界UCS中工作得很好，我希望这个lisp在任何其他UCS中都能工作。谁来帮帮我？我不知道如何使用trans函数。谢谢
 

(defun c:Test ()
(setqpt1 (getpoint "\nINSERTION POINT:"))
(setqpt2 (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))

MSasu 发表于 2022-7-6 07:40:59

要使用TRANS调整移动，请执行以下操作：
(command "MOVE" "L" "" (trans '(0 0 0) 0 1) PT1)
只要UCS不旋转，这将很好地工作-这种情况也需要对旋转角度进行校正。
(command "rotate" "l" "" pt1 (* (/ (angle (trans pt1 1 0) (trans pt2 1 0)) pi) 180))

infipse 发表于 2022-7-6 07:57:52

谢谢，MSasu！

MSasu 发表于 2022-7-6 08:01:40

不客气！

marko_ribar 发表于 2022-7-6 08:18:04

我认为这段代码足够了-我删除了重复的顶点11-它与顶点1相同，并启用了闭合LWPOLYLINE选项-它应该适用于任何UCS。。。
 

(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)))
   (- (* (carv) (caddr u)) (* (caru) (caddr v)))
   (- (* (caru) (cadrv)) (* (carv) (cadru)))
)
)

(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 )
(setqpt1 (getpoint "\nINSERTION POINT:"))
(setqpt2 (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)
)

 
M、 R。

marko_ribar 发表于 2022-7-6 08:24:38

或者，可以通过VLA-OBJECT变换矩阵来实现：
 

(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)))
   (- (* (carv) (caddr u)) (* (caru) (caddr v)))
   (- (* (caru) (cadrv)) (* (carv) (cadru)))
)
)

(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 )
(setqpt1 (getpoint "\nINSERTION POINT:"))
(setqpt2 (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)
)

 
M、 R。

infipse 发表于 2022-7-6 08:30:20

谢谢Marco，太好了！
页: [1]
查看完整版本: 初学者-跨坐标