社区 › Auto Lisp › 如何使LISP正常工作

msirois 发表于 2022-7-5 18:18:50

如何使LISP正常工作

我修改了我办公室里现有的LISP，它在我们的窗户上做了网格线。这一个是用来做草原风格的烤架（线从正方形/矩形的每个边缘偏移4英寸）. 它工作得很好，只是你必须从左上角到右下角选择你的盒子。如果你换一种方式做，那是行不通的。任何帮助都将不胜感激。是的，代码可能做得很差，我很确定它比我老。如果有一种更小/更简单的方法来编写这段代码，我将非常感谢您的帮助。
 
(defun c:Grl2
()
(setq cl (getvar "clayer"))
(setvar "osmode" 183)
(COMMAND "LAYER" "M" "Doors & Windows" "C" "21" "" "")
(setq p1 (getpoint "Pick top left corner: "))
(setq p2 (getcorner p1 "\n Pick bottom right corner: "))      
(setq p3 (list (car p1) (cadr p2)))
(setq p4 (list (car p2) (cadr p1)))
(command "line" p1 p3"")
(if (and (ssget "L")
          (setq of "4"))
   (progn
   (setq undo
       (not
         (vla-StartUndomark
         (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
         )
         )
       )
   )
   
   (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (mapcar
         (function
         (lambda ( o )
             (vl-catch-all-apply
               (function vla-offset) (list obj o)
             )
         )
         )
         (list of)
       )
   )
   (vla-delete ss)

   (setq undo (vla-EndUndoMark doc))
   )
)
(command "erase" (ssget "p")"")

;====================================== roud 2
(command "line" p1 p4"")
(if (and (ssget "L")
(setq of "-4"))
   (progn
   (setq undo
       (not
         (vla-StartUndomark
         (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
         )
         )
       )
   )
   
   (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (mapcar
         (function
         (lambda ( o )
             (vl-catch-all-apply
               (function vla-offset) (list obj o)
             )
         )
         )
         (list of)
       )
   )
   (vla-delete ss)

   (setq undo (vla-EndUndoMark doc))
   )
)
(command "erase" (ssget "p")"")
;====================================== roud 3
(command "line" p2 p4"")
(if (and (ssget "L")
          (setq of "4"))
   (progn
   (setq undo
       (not
         (vla-StartUndomark
         (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
         )
         )
       )
   )
   
   (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (mapcar
         (function
         (lambda ( o )
             (vl-catch-all-apply
               (function vla-offset) (list obj o)
             )
         )
         )
         (list of)
       )
   )
   (vla-delete ss)

   (setq undo (vla-EndUndoMark doc))
   )
)
(command "erase" (ssget "p")"")

;====================================== roud 4
(command "line" p2 p3"")
(if (and (ssget "L")
(setq of "-4"))
   (progn
   (setq undo
       (not
         (vla-StartUndomark
         (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
         )
         )
       )
   )
   
   (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (mapcar
         (function
         (lambda ( o )
             (vl-catch-all-apply
               (function vla-offset) (list obj o)
             )
         )
         )
         (list of)
       )
   )
   (vla-delete ss)

   (setq undo (vla-EndUndoMark doc))
   )
)
(command "erase" (ssget "p")"")
(setvar "clayer" cl)
(princ)
)

BIGAL 发表于 2022-7-5 18:25:17

如果你只是想交换左右选择，只需要做一点检查，如果x1-x2是-ve交换，就这样做
 
在代码中，您可以对偏移进行重复，并且只有一个defun用于绘制线（setq为-4）（doline为）
 
代码可能不会比您老，因为我启动时VL不存在。

ymg3 发表于 2022-7-5 18:25:39

在这里，我重写了它，使它可以从任意两个点开始工作
在对角线上。
 

(defun c:grl2 (/ bb cl l os p1 p2 p3 p4)
(setq os (getvar 'OSMODE))
(setq cl (getvar 'CLAYER))
(setvar 'OSMODE 183)
(command "LAYER" "M" "Doors & Windows" "C" "21" "" "")
(setq p1 (getpoint "Pick First Corner: ")
      p2 (getcorner p1 "\n Pick Diagonal Corner: ")
         l (list p1 p2)
      bb (list (apply 'mapcar (cons 'min l)) (apply 'mapcar (cons 'max l)))
      p3 (car bb)   p4 (cadr bb)
      p1 (list (car p3) (cadr p4))
      p2 (list (car p4) (cadr p3))   
)
(command "_LINE" (list (+ (car p1) 4) (cadr p1)) (list (+ (car p3) 4) (cadr p3)) "")
(command "_LINE" (list (car p1) (- (cadr p1) 4)) (list (car p4) (- (cadr p4) 4)) "")
(command "_LINE" (list (- (car p2) 4) (cadr p2)) (list (- (car p4) 4) (cadr p4)) "")
(command "_LINE" (list (car p2) (+ (cadr p2) 4)) (list (car p3) (+ (cadr p3) 4)) "")
(setvar 'CLAYER cl)
(setvar 'OSMODE os)
(princ)
)

David Bethel 发表于 2022-7-5 18:28:44

我将其保存在图书馆中，以便于访问：
 

;++++++++++++ Get RECTANGLE +++++++++++++++++++++++++
(defun getrect (/ p1 p2)
(initget 1)
(setq p1 (getpoint "\n1st Corner:   "))
(initget 1)
(setq p2 (getcorner p1 "\n2nd Corner:   "))
(setq ll (list (min (car p1) (car p2))
                (min (cadr p1) (cadr p2))
                (caddr p1))
       ur (list (max (car p1) (car p2))
                (max (cadr p1) (cadr p2))
                (caddr p1))
       lr (list (car ur) (cadr ll) (caddr p1))
       ul (list (car ll) (cadr ur) (caddr p1))
       mp (mapcar '(lambda (a b) (* (+ a b) 0.5)) ll ur))
(grdraw ll lr 2 3)
(grdraw lr ur 2 3)
(grdraw ur ul 2 3)
(grdraw ul ll 2 3)
(prin1))

 
 
-大卫

msirois 发表于 2022-7-5 18:31:48

 
您好，谢谢您的回复。这在点击空白区域时有效，但当我在一个矩形中尝试时，直线就会捕捉到该矩形的边界。有什么想法吗？

rlx 发表于 2022-7-5 18:37:50

 
 
只有一个：关闭OSNAP？
 
 
Gr.Rlx

msirois 发表于 2022-7-5 18:39:11

 
关闭OSNAP不允许我选择窗口块的角。我尝试将变量设置为1以简化OSNAP，但仍然没有成功。

rlx 发表于 2022-7-5 18:41:49

 
 
（setvar“osmode”0）不工作？当你需要osnap时打开它，当你不再需要它时打开它。通常我会让用户自己决定是否打开它。
 
 
gr.Rlx

msirois 发表于 2022-7-5 18:44:39

 
从技术上讲，将osmode设置为0是可行的，但当需要选择窗口边界来完成命令时，关闭OSNAP实际上没有意义。每次激活LISP时打开osnaps比手动绘制线条更令人恼火。

rlx 发表于 2022-7-5 18:48:57

 
 
如果我理解正确的话，它在某个时刻捕捉到了错误的点？也许孔径大小会有所不同？

查看完整版本: 如何使LISP正常工作