矩形lisp。帮个小忙！

Bhull1985 · 发表于 2022-7-6 00:36:21

这次行动真的有必要吗？就我个人而言，我认为他对问题的详细描述和他对所述问题的说明远远超过了平淡的一行文章，许多人似乎认为这是对他们问题的准确描述，但老实说，他们几乎没有概述这个问题。。。。这张海报不是这样的，因此我不理解这种敌意，即使它是短暂的和被动的侵略性的。。。
此外，谷歌有没有告诉你，你没有想象力，当你查询信息时，你应该去别处看看？很明显，你们不是谷歌，但如果他们这样做了，你们两个在这方面会很相似。对不起，我不时会注意到这一点，我不认为一个经验不足的lisper应该在为他们准备的论坛上被一个恰当提出的问题所蒙蔽。

Lee Mac · 发表于 2022-7-6 00:39:00

另一个版本：

copy

(defun c:myrec ( / nv oc p1 p2 p3 p4 p5 p6 )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
           (setq p3 (getpoint "\n3rd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p4 (trans p1 1 nv)
                 p5 (trans p2 1 nv)
                 p6 (trans p3 1 nv)
           )
           (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                   (cons 010 (trans p1 1 oc))
                   (cons 010 (trans p2 1 oc))
                   (cons 010 (trans (list (car p6) (cadr p6) (caddr p5)) nv oc))
                   (cons 010 (trans (list (car p6) (cadr p6) (caddr p4)) nv oc))
                   (cons 210 oc)
               )
           )
       )
   )
   (princ)
)

具有动态效果：

copy

(defun c:myrec ( / nv oc p1 p2 p3 p4 p5 pl )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p3 (trans p1 1 nv)
                 p4 (trans p2 1 nv)
           )
           (princ "\n3rd point: ")
           (while (= 5 (car (setq p5 (grread t 13 0))))
               (redraw)
               (setq p5 (trans (cadr p5) 1 nv))
               (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                   (setq pl
                       (list p1 p2
                           (trans (list (car p5) (cadr p5) (caddr p4)) nv 1)
                           (trans (list (car p5) (cadr p5) (caddr p3)) nv 1)
                       )
                   )
                   (cons (last pl) pl)
               )
           )
           (if
               (and
                   (listp (cadr p5))
                   (setq p5 (trans (cadr p5) 1 nv))
               )
               (entmake
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      '(090 . 4)
                      '(070 . 1)
                       (cons 010 (trans p1 1 oc))
                       (cons 010 (trans p2 1 oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p4)) nv oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p3)) nv oc))
                       (cons 210 oc)
                   )
               )
           )
           (redraw)
       )
   )
   (princ)
)

上述内容也应适用于所有UCS和视图。

lrm · 发表于 2022-7-6 00:43:02

这是矩形程序的3D版本。我想我会有一些乐趣，并使用向量方法。叉积用于确定与平面垂直的向量，然后使用叉积确定与p3方向上的线p1p2垂直的向量。注意，包括点积和叉积函数。

copy

(defun c:rect3d        (/ p1 p2 p3 p4 p5  n u m d h)
 ; get three points
 (setq p1 (getpoint "\nPoint 1:   "))
 (setq p2 (getpoint p1 "\n2nd Point:   "))
 (setq p3 (getpoint p2 "\Opposing edge Point:   "))
 ; compute normal to plane defined by p1 p2 p3
 (setq n (cross (mapcar '- p3 p1) (mapcar '- p2 p1)))
 ; compute vector perpendicular to line p1 p2
 (setq u (cross (mapcar '- p2 p1) n))
 ; compute magnitude of u
 (setq m (distance '(0 0 0) u))
 ;convert u to unit vector
 (setq u (mapcar '/ u (list m m m)))
 ; get perpendicular length from line p1p2 to point p3
 (setq d (dot (mapcar '- p3 p1) u))
 ;convert length to a vector
 (setq h (mapcar '* (list d d d) u))
 ;define other two corners of the rectangle
 (setq p4 (mapcar '+ p1 h))
 (setq p5 (mapcar '+ p2 h))
 (command "3dpoly" p1 p2 p5 p4 p1 "")
 (princ)
)
; Compute the dot product of 2 vectors a and b
(defun dot (a b / dd)
 (setq dd (mapcar '* a b))
 (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
)                                        ;end of dot
; Compute the cross product of 2 vectors a and b
(defun cross (a b / crs)
 (setq        crs (list
      (- (* (nth 1 a) (nth 2 b))
         (* (nth 1 b) (nth 2 a))
      )
      (- (* (nth 0 b) (nth 2 a))
         (* (nth 0 a) (nth 2 b))
      )
      (- (* (nth 0 a) (nth 1 b))
         (* (nth 0 b) (nth 1 a))
      )
    )                                ;end list
 )                                        ;end setq c
)                                        ;end cross

prodromosm · 发表于 2022-7-6 00:45:47

[/code]
具有动态效果：
[code](defun c:myrec ( / nv oc p1 p2 p3 p4 p5 pl )
(if
   (and
         (setq p1 (getpoint "\n1st point: "))
         (setq p2 (getpoint "\n2nd point: " p1))
   )
   (progn
         (setq nv (trans (mapcar '- p2 p1) 1 0 t)
               oc (trans '(0.0 0.0 1.0) 1 0 t)
               p3 (trans p1 1 nv)
               p4 (trans p2 1 nv)
         )
         (princ "\n3rd point: ")
         (while (= 5 (car (setq p5 (grread t 13 0))))
            (redraw)
            (setq p5 (trans (cadr p5) 1 nv))
            (mapcar '(lambda ( a b ) (grdraw a b 1 1))
               (setq pl
                     (list p1 p2
                        (trans (list (car p5) (cadr p5) (caddr p4)) nv 1)
                        (trans (list (car p5) (cadr p5) (caddr p3)) nv 1)
                     )
               )
               (cons (last pl) pl)
            )
         )
         (if
            (and
               (listp (cadr p5))
               (setq p5 (trans (cadr p5) 1 nv))
            )
            (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                     (cons 010 (trans p1 1 oc))
                     (cons 010 (trans p2 1 oc))
                     (cons 010 (trans (list (car p5) (cadr p5) (caddr p4)) nv oc))
                     (cons 010 (trans (list (car p5) (cadr p5) (caddr p3)) nv oc))
                     (cons 210 oc)
               )
            )
         )
         (redraw)
   )
)
(princ)
)[/code]
上述内容也应适用于所有UCS和视图。

干得好，李。我喜欢这个Lisp程序

SLW210 · 发表于 2022-7-6 00:47:06

lrm，

请阅读代码发布指南，并将代码放在代码标签中。

prodromosm · 发表于 2022-7-6 00:50:20

李先生，这个Lisp程序有点问题
当我选择点1和点2时，osnap处于启用状态。当我试图选择点3时，osnap关闭了为什么？你能修好它吗！！谢谢

MSasu · 发表于 2022-7-6 00:54:12

Prodromosm，该行为来自第三点（GRREAD）使用二元输入；不幸的是，这不适用于OSNAP模式。

prodromosm · 发表于 2022-7-6 00:56:25

你能添加一个命令来修复它吗？？

MSasu · 发表于 2022-7-6 01:02:17

似乎有一些工作要做；您可能需要检查此线程。

Lee Mac · 发表于 2022-7-6 01:05:01

如MSasu所示，当使用AutoLISP grread功能监控用户输入时，不幸禁用了所有标准绘图辅助工具（对象捕捉/正交模式/跟踪等）。

DynDraw。Alexander Rivilis在MSasu建议的线程中提出的arx实用程序提供了grread函数的替代方法，允许使用所有绘图辅助工具，但需要重写程序才能与此函数一起使用。

否则，我建议您只使用我上面提供的非动态版本。

[编程交流] 矩形lisp。帮个小忙！

发表回复

精选推荐