乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 61|回复: 19

[编程交流] 如何使LISP正常工作

[复制链接]

5

主题

34

帖子

29

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-5 18:18:50 | 显示全部楼层 |阅读模式
我修改了我办公室里现有的LISP,它在我们的窗户上做了网格线。这一个是用来做草原风格的烤架(线从正方形/矩形的每个边缘偏移4英寸). 它工作得很好,只是你必须从左上角到右下角选择你的盒子。如果你换一种方式做,那是行不通的。任何帮助都将不胜感激。是的,代码可能做得很差,我很确定它比我老。如果有一种更小/更简单的方法来编写这段代码,我将非常感谢您的帮助。
 
  1. (defun c:Grl2
  2. ()
  3. (setq cl (getvar "clayer"))
  4. (setvar "osmode" 183)
  5. (COMMAND "LAYER" "M" "Doors & Windows" "C" "21" "" "")
  6. (setq p1 (getpoint "Pick top left corner: "))
  7. (setq p2 (getcorner p1 "\n Pick bottom right corner: "))      
  8. (setq p3 (list (car p1) (cadr p2)))
  9. (setq p4 (list (car p2) (cadr p1)))
  10. (command "line" p1 p3"")
  11. (if (and (ssget "L")
  12.           (setq of "4"))
  13.    (progn
  14.      (setq undo
  15.        (not
  16.          (vla-StartUndomark
  17.            (setq doc
  18.              (vla-get-ActiveDocument
  19.                (vlax-get-acad-object)
  20.              )
  21.            )
  22.          )
  23.        )
  24.      )
  25.      
  26.      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
  27.        (mapcar
  28.          (function
  29.            (lambda ( o )
  30.              (vl-catch-all-apply
  31.                (function vla-offset) (list obj o)
  32.              )
  33.            )
  34.          )
  35.          (list of)
  36.        )
  37.      )
  38.      (vla-delete ss)
  39.      (setq undo (vla-EndUndoMark doc))
  40.    )
  41. )
  42. (command "erase" (ssget "p")"")
  43. ;====================================== roud 2
  44. (command "line" p1 p4"")
  45. (if (and (ssget "L")
  46. (setq of "-4"))
  47.    (progn
  48.      (setq undo
  49.        (not
  50.          (vla-StartUndomark
  51.            (setq doc
  52.              (vla-get-ActiveDocument
  53.                (vlax-get-acad-object)
  54.              )
  55.            )
  56.          )
  57.        )
  58.      )
  59.      
  60.      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
  61.        (mapcar
  62.          (function
  63.            (lambda ( o )
  64.              (vl-catch-all-apply
  65.                (function vla-offset) (list obj o)
  66.              )
  67.            )
  68.          )
  69.          (list of)
  70.        )
  71.      )
  72.      (vla-delete ss)
  73.      (setq undo (vla-EndUndoMark doc))
  74.    )
  75. )
  76. (command "erase" (ssget "p")"")
  77. ;====================================== roud 3
  78. (command "line" p2 p4"")
  79. (if (and (ssget "L")
  80.           (setq of "4"))
  81.    (progn
  82.      (setq undo
  83.        (not
  84.          (vla-StartUndomark
  85.            (setq doc
  86.              (vla-get-ActiveDocument
  87.                (vlax-get-acad-object)
  88.              )
  89.            )
  90.          )
  91.        )
  92.      )
  93.      
  94.      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
  95.        (mapcar
  96.          (function
  97.            (lambda ( o )
  98.              (vl-catch-all-apply
  99.                (function vla-offset) (list obj o)
  100.              )
  101.            )
  102.          )
  103.          (list of)
  104.        )
  105.      )
  106.      (vla-delete ss)
  107.      (setq undo (vla-EndUndoMark doc))
  108.    )
  109. )
  110. (command "erase" (ssget "p")"")
  111. ;====================================== roud 4
  112. (command "line" p2 p3"")
  113. (if (and (ssget "L")
  114. (setq of "-4"))
  115.    (progn
  116.      (setq undo
  117.        (not
  118.          (vla-StartUndomark
  119.            (setq doc
  120.              (vla-get-ActiveDocument
  121.                (vlax-get-acad-object)
  122.              )
  123.            )
  124.          )
  125.        )
  126.      )
  127.      
  128.      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
  129.        (mapcar
  130.          (function
  131.            (lambda ( o )
  132.              (vl-catch-all-apply
  133.                (function vla-offset) (list obj o)
  134.              )
  135.            )
  136.          )
  137.          (list of)
  138.        )
  139.      )
  140.      (vla-delete ss)
  141.      (setq undo (vla-EndUndoMark doc))
  142.    )
  143. )
  144. (command "erase" (ssget "p")"")
  145. (setvar "clayer" cl)
  146. (princ)
  147. )
回复

使用道具 举报

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 18:25:17 | 显示全部楼层
如果你只是想交换左右选择,只需要做一点检查,如果x1-x2是-ve交换,就这样做
 
在代码中,您可以对偏移进行重复,并且只有一个defun用于绘制线(setq为-4)(doline为)
 
代码可能不会比您老,因为我启动时VL不存在。
回复

使用道具 举报

0

主题

301

帖子

301

银币

初来乍到

Rank: 1

铜币
0
发表于 2022-7-5 18:25:39 | 显示全部楼层
在这里,我重写了它,使它可以从任意两个点开始工作
在对角线上。
 
  1. (defun c:grl2 (/ bb cl l os p1 p2 p3 p4)
  2.   (setq os (getvar 'OSMODE))
  3.   (setq cl (getvar 'CLAYER))
  4.   (setvar 'OSMODE 183)
  5.   (command "LAYER" "M" "Doors & Windows" "C" "21" "" "")
  6.   (setq p1 (getpoint "Pick First Corner: ")
  7.         p2 (getcorner p1 "\n Pick Diagonal Corner: ")
  8.          l (list p1 p2)
  9.         bb (list (apply 'mapcar (cons 'min l)) (apply 'mapcar (cons 'max l)))
  10.         p3 (car bb)   p4 (cadr bb)
  11.         p1 (list (car p3) (cadr p4))
  12.         p2 (list (car p4) (cadr p3))   
  13.   )
  14.   (command "_LINE" (list (+ (car p1) 4) (cadr p1)) (list (+ (car p3) 4) (cadr p3)) "")
  15.   (command "_LINE" (list (car p1) (- (cadr p1) 4)) (list (car p4) (- (cadr p4) 4)) "")
  16.   (command "_LINE" (list (- (car p2) 4) (cadr p2)) (list (- (car p4) 4) (cadr p4)) "")
  17.   (command "_LINE" (list (car p2) (+ (cadr p2) 4)) (list (car p3) (+ (cadr p3) 4)) "")
  18.   (setvar 'CLAYER cl)
  19.   (setvar 'OSMODE os)
  20.   (princ)
  21. )
回复

使用道具 举报

26

主题

1495

帖子

20

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
118
发表于 2022-7-5 18:28:44 | 显示全部楼层
我将其保存在图书馆中,以便于访问:
 
  1. [color=#8b4513];++++++++++++ Get RECTANGLE +++++++++++++++++++++++++[/color]
  2. [b][color=BLACK]([/color][/b]defun getrect [b][color=FUCHSIA]([/color][/b]/ p1 p2[b][color=FUCHSIA])[/color][/b]
  3. [b][color=FUCHSIA]([/color][/b]initget 1[b][color=FUCHSIA])[/color][/b]
  4. [b][color=FUCHSIA]([/color][/b]setq p1 [b][color=NAVY]([/color][/b]getpoint [color=#2f4f4f]"\n1st Corner:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  5. [b][color=FUCHSIA]([/color][/b]initget 1[b][color=FUCHSIA])[/color][/b]
  6. [b][color=FUCHSIA]([/color][/b]setq p2 [b][color=NAVY]([/color][/b]getcorner p1 [color=#2f4f4f]"\n2nd Corner:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  7. [b][color=FUCHSIA]([/color][/b]setq ll [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]min [b][color=GREEN]([/color][/b]car p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]car p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
  8.                 [b][color=MAROON]([/color][/b]min [b][color=GREEN]([/color][/b]cadr p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cadr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
  9.                 [b][color=MAROON]([/color][/b]caddr p1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  10.        ur [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]max [b][color=GREEN]([/color][/b]car p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]car p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
  11.                 [b][color=MAROON]([/color][/b]max [b][color=GREEN]([/color][/b]cadr p1[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cadr p2[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
  12.                 [b][color=MAROON]([/color][/b]caddr p1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  13.        lr [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]car ur[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]cadr ll[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]caddr p1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  14.        ul [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]car ll[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]cadr ur[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]caddr p1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
  15.        mp [b][color=NAVY]([/color][/b]mapcar '[b][color=MAROON]([/color][/b]lambda [b][color=GREEN]([/color][/b]a b[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]* [b][color=BLUE]([/color][/b]+ a b[b][color=BLUE])[/color][/b] 0.5[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] ll ur[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
  16. [b][color=FUCHSIA]([/color][/b]grdraw ll lr 2 3[b][color=FUCHSIA])[/color][/b]
  17. [b][color=FUCHSIA]([/color][/b]grdraw lr ur 2 3[b][color=FUCHSIA])[/color][/b]
  18. [b][color=FUCHSIA]([/color][/b]grdraw ur ul 2 3[b][color=FUCHSIA])[/color][/b]
  19. [b][color=FUCHSIA]([/color][/b]grdraw ul ll 2 3[b][color=FUCHSIA])[/color][/b]
  20. [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 
 
-大卫
回复

使用道具 举报

5

主题

34

帖子

29

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-5 18:31:48 | 显示全部楼层
 
您好,谢谢您的回复。这在点击空白区域时有效,但当我在一个矩形中尝试时,直线就会捕捉到该矩形的边界。有什么想法吗?
回复

使用道具 举报

rlx

21

主题

1505

帖子

1551

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
81
发表于 2022-7-5 18:37:50 | 显示全部楼层
 
 
只有一个:关闭OSNAP?
 
 
Gr.Rlx
回复

使用道具 举报

5

主题

34

帖子

29

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-5 18:39:11 | 显示全部楼层
 
关闭OSNAP不允许我选择窗口块的角。我尝试将变量设置为1以简化OSNAP,但仍然没有成功。
回复

使用道具 举报

rlx

21

主题

1505

帖子

1551

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
81
发表于 2022-7-5 18:41:49 | 显示全部楼层
 
 
(setvar“osmode”0)不工作?当你需要osnap时打开它,当你不再需要它时打开它。通常我会让用户自己决定是否打开它。
 
 
gr.Rlx
回复

使用道具 举报

5

主题

34

帖子

29

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-5 18:44:39 | 显示全部楼层
 
从技术上讲,将osmode设置为0是可行的,但当需要选择窗口边界来完成命令时,关闭OSNAP实际上没有意义。每次激活LISP时打开osnaps比手动绘制线条更令人恼火。
回复

使用道具 举报

rlx

21

主题

1505

帖子

1551

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
81
发表于 2022-7-5 18:48:57 | 显示全部楼层
 
 
如果我理解正确的话,它在某个时刻捕捉到了错误的点?也许孔径大小会有所不同?
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-12 19:46 , Processed in 0.379707 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表