社区 › Auto Lisp › 顶视图和侧视图矩形

jason_a 发表于 2022-7-5 16:50:48

顶视图和侧视图矩形

你好
 
我正在尝试创建一个lisp例程，该例程将基于前视图创建顶视图和侧视图矩形。我附上了一张图片供参考。我想点击白色面板的两个相对的角，然后创建两个厚度为25.4的绿色矩形。这可能吗？
 
谢谢

Grrr 发表于 2022-7-5 16:57:03

嗨，试试这个：

(defun C:test ( / *error* p1 p2 right top lr lt main )
(defun *error* nil (redraw) (princ))
(while
   (and
   (setq p1 (getpoint "\nSpecify bottom left corner <exit>: "))
   (setq p2 (getcorner p1 "\nSpecify top right corner <exit>: "))
   )
   (and
   (setq p1 (trans p1 1 0) p2 (trans p2 1 0))
   (setq right (lambda (x) (polar x 0. 25.4)))
   (setq top (lambda (x) (polar x (/ PI 2) 25.4)))
   (setq lr (mapcar 'right (list p2 (list (car p2) (cadr p1) 0.))))
   (setq lt (mapcar 'top (list p2 (list (car p1) (cadr p2) 0.))))
   (setq lr (append (reverse (mapcar 'right lr)) lr))
   (setq lt (append (reverse (mapcar 'top lt)) lt))
   (setq main (list p1 (list (car p1) (cadr p2) 0.) p2 (list (car p2) (cadr p1) 0.) ))
   (not (redraw))
   (not (grvecs (cons -1 (apply 'append (mapcar 'list main (cons (last main ) main))))))
   (LWPoly lr 1)
   (LWPoly lt 1)
   )
)
(redraw)(princ)
)

; Lee Mac
(defun LWPoly (lst cls)
(entmakex
   (append
   (list
       (cons 0 "LWPOLYLINE")
       (cons 100 "AcDbEntity")
       (cons 100 "AcDbPolyline")
       (cons 90 (length lst))
       (cons 70 cls)
   )
   (mapcar (function (lambda (p) (cons 10 p))) lst)
   )
)
)

jason_a 发表于 2022-7-5 17:00:48

非常好用，非常感谢！这是一个很大的帮助，我很感激。

BIGAL 发表于 2022-7-5 17:02:46

jason_a为什么不画矩形作为这个函数的一部分？1 pt，L&W全部完成。

jason_a 发表于 2022-7-5 17:06:49

我每天在我的工作中起草许多正交视图，不幸的是，输入值会减慢我的速度。不过谢谢你的建议，它可以在我的工作流程中的其他地方派上用场。

ReMark 发表于 2022-7-5 17:10:32

也许你应该在3D中工作，并从模型中生成2D视图。

jason_a 发表于 2022-7-5 17:12:03

 
最后，可以修改lisp例程以允许用户输入面板的厚度吗？它目前有一个默认值25.4，我已经应用于一个按钮，适用于我的大部分工作流程。但在奇怪的情况下，我需要一个不同的值，第二个允许用户定义输入的按钮也会有所帮助。

Grrr 发表于 2022-7-5 17:16:49

 
是的：

(defun C:test ( / *error* p1 p2 n right top lr lt main )
(defun *error* nil (redraw) (princ))
(while
   (and
   (setq p1 (getpoint "\nSpecify bottom left corner <exit>: "))
   (setq p2 (getcorner p1 "\nSpecify top right corner <exit>: "))
   (not (initget (+ 2 4))) (or (setq n (getreal "\nSpecify thickness value <25.4>: ")) (setq n 25.4))
   )
   (and
   (setq p1 (trans p1 1 0) p2 (trans p2 1 0))
   (setq right (lambda (x) (polar x 0. n)))
   (setq top (lambda (x) (polar x (/ PI 2) n)))
   (setq lr (mapcar 'right (list p2 (list (car p2) (cadr p1) 0.))))
   (setq lt (mapcar 'top (list p2 (list (car p1) (cadr p2) 0.))))
   (setq lr (append (reverse (mapcar 'right lr)) lr))
   (setq lt (append (reverse (mapcar 'top lt)) lt))
   (setq main (list p1 (list (car p1) (cadr p2) 0.) p2 (list (car p2) (cadr p1) 0.) ))
   (not (redraw))
   (not (grvecs (cons -1 (apply 'append (mapcar 'list main (cons (last main ) main))))))
   (mapcar '(lambda (x) (LWPoly x 1)) (list lr lt))
   )
)
(redraw)(princ)
)

jason_a 发表于 2022-7-5 17:20:42

效果很好！谢谢你，先生！

Lee Mac 发表于 2022-7-5 17:25:09

 
我喜欢你使用“right”和“top”函数——我看你现在对mapcar有了很好的理解
 
但是，请注意，*error*函数需要一个参数-如果遇到错误，以下函数将返回“参数过多”错误：
(defun *error* nil (redraw) (princ))

查看完整版本: 顶视图和侧视图矩形