Lisp-圆乐筑天下 - Powered by Discuz! Archiver

Lukepeanuts 发表于 2022-7-5 17:41:00

我用您的建议和提示更新了lisp，方法如下：

(DEFUN c:CPU ( / CNT DIAM INCH)

(setq CNT (getpoint "\nselect circle center"));click the center of the circle

(initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")
(setq INCH (getkword "\nSelect Diameter: "))
;To do not write the real diameter number

(setq DIAM (cond ((= INCH "2") 0.060325)
((= INCH "2.5") 0.073025)
((= INCH "3") 0.0889)
((= INCH "3.5") 0.1016)
((= INCH "4") 0.1143)
((= INCH "6") 0.1683)
((= INCH "8") 0.2191)
((= INCH "10") 0.2730)
((= INCH "12") 0.3238)
((= INCH "14") 0.3556)
((= INCH "16") 0.4064)
((= INCH "18") 0.4572)
((= INCH "20") 0.5080)
);End conditional
) ;End setq

(command "circle" "_non" CNT "D" DIAM);draw the circle

(PRIN1)
)

Lisp程序可以按照我的需要工作。之后，我想把圆放在与当前不同的层中（选择一个对象），然后返回到我的原始层。所以我写了这个新的lisp：

(DEFUN c:CPU2 ( / CNT DIAM INCH P1)

(setq P1 (entsel "\nSelect an object to create the circle in the same layer: "))
(setq CNT (getpoint "\nselect circle center"));click the center of the circle

(initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")
(setq INCH (getkword "\nSelect Diameter: "))
;To do not write the real diameter number

(setq DIAM (cond ((= INCH "2") 0.060325)
((= INCH "2.5") 0.073025)
((= INCH "3") 0.0889)
((= INCH "3.5") 0.1016)
((= INCH "4") 0.1143)
((= INCH "6") 0.1683)
((= INCH "8") 0.2191)
((= INCH "10") 0.2730)
((= INCH "12") 0.3238)
((= INCH "14") 0.3556)
((= INCH "16") 0.4064)
((= INCH "18") 0.4572)
((= INCH "20") 0.5080)
);End conditional
) ;End setq DIAM

(command "laymcur" P1; to move in other layer with a select
(command "circle" "_non" CNT "D" DIAM);draw the circle
(command "layerp"); return in the original layer

(PRINC)
)

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

marko_ribar 发表于 2022-7-5 17:41:53

此处的右括号在哪里：

(command "laymcur" P1; to move in other layer with a select

实际上，您提供的是使用（entsel）获得的列表，在我看来，您应该指定ENAME（carp1）。。。
从未使用命令“laymcur”；您可以通过以下方式实现同样的效果：

(setvar 'clayer (cdr (assoc 8 (entget (car P1)))))

HTH，M.R。

Lukepeanuts 发表于 2022-7-5 17:46:13

谢谢又一个新手失误。我不知道如何使用你给我写的setvar。你能插入我的Lisp程序吗？这样我会努力研究它。
使用“clayer”时，是否要使用autocad命令clayer？这样，为什么它写得不像“克莱尔”？无论如何，我不能使用clayer命令，因为层名称不容易记住，对于我想使用lisp的文件

tombu 发表于 2022-7-5 17:50:32

AutoCAD很酷的一点是，有很多不同的方法可以做任何事情。
(vl-load-com)
(DEFUN c:CPU2 ( / OBJLAY CNT INCH DIAM radius circleObj)
(setq OBJLAY (cdr (assoc 8 (entget (car (entsel "\nSelect an object to create the circle in the same layer: ")))))
      CNT (vlax-3d-point (getpoint "\nSelect circle center: ")) ;click the center of the circle
)

(initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")
(setq INCH (getkword "\nSelect Diameter: "))
;To do not write the real diameter number

(setq DIAM (cond ((= INCH "2") 0.060325)
((= INCH "2.5") 0.073025)
((= INCH "3") 0.0889)
((= INCH "3.5") 0.1016)
((= INCH "4") 0.1143)
((= INCH "6") 0.1683)
((= INCH "8") 0.2191)
((= INCH "10") 0.2730)
((= INCH "12") 0.3238)
((= INCH "14") 0.3556)
((= INCH "16") 0.4064)
((= INCH "18") 0.4572)
((= INCH "20") 0.5080)
         );End conditional
         radius (/ DIAM 2)
) ;End setq DIAM

(if (= 1 (getvar 'cvport))
(setq circleObj (vla-AddCircle (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) CNT radius))
(setq circleObj (vla-AddCircle (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))) CNT radius))
)
(vl-catch-all-apply 'vla-put-Layer (list circleObj OBJLAY))
(PRINC)
)

Grrr 发表于 2022-7-5 17:51:08

以下是我对该代码的修订：
(defun C:CPU ( / e p Lst str r )
(setq e (car (entsel "\nSelect an object to create the circle in the same layer: ")))
(initget 1) (setq p (getpoint "\nSpecify circle's center: "))
(setq Lst
(mapcar 'list
(mapcar 'rtos (list 2 2.5 3 3.5 4 6 8 10 12 14 16 18 20))
(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)
)
)
(apply '(lambda (x) (initget 1 x)) (list (vl-string-translate "/" " " (setq str (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) (mapcar 'car Lst)))))))
(setq r (/ (nth (vl-position (getkword (strcat "\nSelect Diameter: [" (vl-string-right-trim " /" str) "]")) (mapcar 'car Lst)) (mapcar 'cadr Lst)) 2.))
(and p r (entmakex (list (cons 0 "CIRCLE")(cons 10 p)(if e (assoc 8 (entget e))(cons 8 (getvar 'clayer)))(cons 40 r))))
(princ)
);| defun |; (vl-load-com) (princ)

BIGAL 发表于 2022-7-5 17:56:45

另一种方法可能是有一个公式的价值？2.5=0.073025如何

tombu 发表于 2022-7-5 17:57:52

非常好的mapcar lambda示例。我喜欢层对象的测试。

就像比格尔想知道这个公式是怎么产生的。

Lee Mac 发表于 2022-7-5 18:03:04

代码不错，这里有一些提示：

此处不需要应用：
(apply '(lambda (x) (initget 1 x)) (list (vl-string-translate "/" " " (setq str (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) (mapcar 'car Lst)))))))
请注意，这里可以使用assoc：
(nth (vl-position (getkword (strcat "\nSelect Diameter: [" (vl-string-right-trim " /" str) "]")) (mapcar 'car Lst)) (mapcar 'cadr Lst))
16

Grrr 发表于 2022-7-5 18:04:15

谢谢李，我努力向最好的人学习！

我正在用列表操作洗脑，我没有注意到（apply）可以跳过。
我认为我可以使用（assoc），但决定使用我不太熟悉的函数进行练习，例如（vl位置）。

页: 1 [2]

乐筑天下's Archiver