乐筑天下

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

[编程交流] Lisp-圆

[复制链接]
Lukepeanuts

3

主题

9

帖子

6

银币

初来乍到

Rank: 1

铜币
15
发表于 2022-7-5 17:41:00 | 显示全部楼层
我用您的建议和提示更新了lisp，方法如下：
 
  1. (DEFUN c:CPU ( / CNT DIAM INCH)
  3.  (setq CNT (getpoint "\nselect circle center"));click the center of the circle
  4.  
  5.          (initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")
  6.          (setq INCH (getkword "\nSelect Diameter: [2 / 2.5 / 3 / 3.5 / 4 / 6 / 8 / 10 / 12 / 14 / 16 / 18 / 20]"))
  7.          ;To do not write the real diameter number
  9.          (setq DIAM (cond ((= INCH "2") 0.060325)
  10.                  ((= INCH "2.5") 0.073025)
  11.                  ((= INCH "3") 0.0889)
  12.                  ((= INCH "3.5") 0.1016)
  13.                  ((= INCH "4") 0.1143)                         
  14.                  ((= INCH "6") 0.1683)
  15.                  ((= INCH "8") 0.2191)
  16.                  ((= INCH "10") 0.2730)
  17.                  ((= INCH "12") 0.3238)
  18.                  ((= INCH "14") 0.3556)
  19.                  ((= INCH "16") 0.4064)
  20.                  ((= INCH "18") 0.4572)
  21.                  ((= INCH "20") 0.5080)                         
  22.             );End conditional
  23.          ) ;End setq
  25.                   (command "circle" "_non" CNT "D" DIAM);draw the circle
  26.         
  27.  (PRIN1)
  28.  )

 
Lisp程序可以按照我的需要工作。之后，我想把圆放在与当前不同的层中（选择一个对象），然后返回到我的原始层。所以我写了这个新的lisp：
 
  1. (DEFUN c:CPU2 ( / CNT DIAM INCH P1)
  3.                  (setq P1 (entsel "\nSelect an object to create the circle in the same layer: "))
  4.                  (setq CNT (getpoint "\nselect circle center"));click the center of the circle
  5.  
  6.                  (initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")
  7.                  (setq INCH (getkword "\nSelect Diameter: [2 / 2.5 / 3 / 3.5 / 4 / 6 / 8 / 10 / 12 / 14 / 16 / 18 / 20]"))
  8.                  ;To do not write the real diameter number
  10.                  (setq DIAM (cond ((= INCH "2") 0.060325)
  11.                  ((= INCH "2.5") 0.073025)
  12.                  ((= INCH "3") 0.0889)
  13.                  ((= INCH "3.5") 0.1016)
  14.                  ((= INCH "4") 0.1143)                         
  15.                  ((= INCH "6") 0.1683)
  16.                  ((= INCH "8") 0.2191)
  17.                  ((= INCH "10") 0.2730)
  18.                  ((= INCH "12") 0.3238)
  19.                  ((= INCH "14") 0.3556)
  20.                  ((= INCH "16") 0.4064)
  21.                  ((= INCH "18") 0.4572)
  22.                  ((= INCH "20") 0.5080)                         
  23.                        );End conditional
  24.                  ) ;End setq DIAM
  26.                   (command "laymcur" P1; to move in other layer with a select
  27.                  (command "circle" "_non" CNT "D" DIAM);draw the circle
  28.         (command "layerp"); return in the original layer
  29.                          
  30.  (PRINC)
  31.  )

 
像往常一样，我正在使用autocad的加载应用程序。该程序表示lisp已成功加载，但当我稍后在autocad中写入lisp名称时，该程序未找到lisp。
如果我写CPU，autocad会找到第一个lisp，但如果我写CPU2，它不会找到第二个lisp（它只找到第一个。我试图将其加载到另一台计算机中，但我遇到了相同的问题。是因为新的lisp不正确还是什么？
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

铜币
-20
发表于 2022-7-5 17:41:53 | 显示全部楼层
此处的右括号在哪里：
 
  2. (command "laymcur" P1; to move in other layer with a select

 
实际上，您提供的是使用（entsel）获得的列表，在我看来，您应该指定ENAME（carp1）。。。
从未使用命令“laymcur”；您可以通过以下方式实现同样的效果：
 
  2. (setvar 'clayer (cdr (assoc 8 (entget (car P1)))))

 
HTH，M.R。
回复

使用道具 举报

Lukepeanuts

3

主题

9

帖子

6

银币

初来乍到

Rank: 1

铜币
15
发表于 2022-7-5 17:46:13 | 显示全部楼层
 
谢谢又一个新手失误。我不知道如何使用你给我写的setvar。你能插入我的Lisp程序吗？这样我会努力研究它。
使用“clayer”时，是否要使用autocad命令clayer？这样，为什么它写得不像“克莱尔”？无论如何，我不能使用clayer命令，因为层名称不容易记住，对于我想使用lisp的文件
回复

使用道具 举报

tombu

17

主题

1274

帖子

25

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
260
发表于 2022-7-5 17:50:32 | 显示全部楼层
AutoCAD很酷的一点是，有很多不同的方法可以做任何事情。
  1. (vl-load-com)
  2. (DEFUN c:CPU2 ( / OBJLAY CNT INCH DIAM radius circleObj)
  3.                  (setq OBJLAY (cdr (assoc 8 (entget (car (entsel "\nSelect an object to create the circle in the same layer: ")))))
  4.                        CNT (vlax-3d-point (getpoint "\nSelect circle center: "))                ;click the center of the circle
  5.                  )
  6.  
  7.                  (initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")
  8.                  (setq INCH (getkword "\nSelect Diameter: [2 / 2.5 / 3 / 3.5 / 4 / 6 / 8 / 10 / 12 / 14 / 16 / 18 / 20]"))
  9.                  ;To do not write the real diameter number
  11.                  (setq DIAM (cond ((= INCH "2") 0.060325)
  12.                  ((= INCH "2.5") 0.073025)
  13.                  ((= INCH "3") 0.0889)
  14.                  ((= INCH "3.5") 0.1016)
  15.                  ((= INCH "4") 0.1143)                         
  16.                  ((= INCH "6") 0.1683)
  17.                  ((= INCH "8") 0.2191)
  18.                  ((= INCH "10") 0.2730)
  19.                  ((= INCH "12") 0.3238)
  20.                  ((= INCH "14") 0.3556)
  21.                  ((= INCH "16") 0.4064)
  22.                  ((= INCH "18") 0.4572)
  23.                  ((= INCH "20") 0.5080)                         
  24.                        );End conditional
  25.                        radius (/ DIAM 2)
  26.                  ) ;End setq DIAM
  27.                  
  28.                  (if (= 1 (getvar 'cvport))
  29.                 (setq circleObj (vla-AddCircle (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) CNT radius))
  30.                 (setq circleObj (vla-AddCircle (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) CNT radius))
  31.                  )
  32.                  (vl-catch-all-apply 'vla-put-Layer (list circleObj OBJLAY))
  33.  (PRINC)
  34.  )
回复

使用道具 举报

Grrr

66

主题

1552

帖子

1514

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
325
发表于 2022-7-5 17:51:08 | 显示全部楼层
以下是我对该代码的修订：
  1. (defun C:CPU ( / e p Lst str r )
  2. (setq e (car (entsel "\nSelect an object to create the circle in the same layer: ")))
  3. (initget 1) (setq p (getpoint "\nSpecify circle's center: "))
  4. (setq Lst 
  5.         (mapcar 'list 
  6.                 (mapcar 'rtos (list 2 2.5 3 3.5 4 6 8 10 12 14 16 18 20)) 
  7.                 (list 0.060325 0.073025 0.0889 0.1016 0.1143 0.1683 0.2191 0.2730 0.3238 0.3556 0.4064 0.4572 0.5080)
  8.         )
  9. )
  10. (apply '(lambda (x) (initget 1 x)) (list (vl-string-translate "/" " " (setq str (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) (mapcar 'car Lst)))))))
  11. (setq r (/ (nth (vl-position (getkword (strcat "\nSelect Diameter: [" (vl-string-right-trim " /" str) "]")) (mapcar 'car Lst)) (mapcar 'cadr Lst)) 2.))
  12. (and p r (entmakex (list (cons 0 "CIRCLE")(cons 10 p)(if e (assoc 8 (entget e))(cons 8 (getvar 'clayer)))(cons 40 r))))
  13. (princ)
  14. );| defun |; (vl-load-com) (princ)
回复

使用道具 举报

BIGAL

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 17:56:45 | 显示全部楼层
另一种方法可能是有一个公式的价值？2.5=0.073025如何
回复

使用道具 举报

tombu

17

主题

1274

帖子

25

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
260
发表于 2022-7-5 17:57:52 | 显示全部楼层
 
非常好的mapcar lambda示例。我喜欢层对象的测试。
 
就像比格尔想知道这个公式是怎么产生的。
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-5 18:03:04 | 显示全部楼层
 
代码不错，这里有一些提示：
 
此处不需要应用：
  1. (apply '(lambda (x) (initget 1 x)) (list (vl-string-translate "/" " " (setq str (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) (mapcar 'car Lst)))))))

请注意，这里可以使用assoc：
  1. (nth (vl-position (getkword (strcat "\nSelect Diameter: [" (vl-string-right-trim " /" str) "]")) (mapcar 'car Lst)) (mapcar 'cadr Lst))
  1. 16
回复

使用道具 举报

Grrr

66

主题

1552

帖子

1514

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
325
发表于 2022-7-5 18:04:15 | 显示全部楼层
谢谢李，我努力向最好的人学习！
 
我正在用列表操作洗脑，我没有注意到（apply）可以跳过。
我认为我可以使用（assoc），但决定使用我不太熟悉的函数进行练习，例如（vl位置）。
回复

使用道具 举报

12
返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-14 02:11 , Processed in 2.291193 second(s), 68 queries .

© 2020-2025 乐筑天下

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