请求-重新创建此lisp

ttray33y · 发表于 2022-7-5 18:26:20

嗨，lisp大师，我需要你们的专业知识。
我需要有人重新创建这个受保护的lisp。
（我不想去保护它，但用相同的功能重新制作/重新创建/重写）。
试试Lisp程序。QW。lsp

原因是，他想知道他（这里的一些老家伙，但多年前离开了公司）是如何做到这一点的。

Tharwat · 发表于 2022-7-5 18:29:52

Lisp程序是做什么的？你能上传该功能的记录视图（视频）吗？

ttray33y · 发表于 2022-7-5 18:33:29

命令为QW，
调用它时，要求进行选择，任何选择都会生成当前图层/线型（如果它选择一条线/多线作为默认值）。
它还可以选择块和文本。
它就像一个包含属性的复制实体/对象。

注意：我将在12小时后删除附加的视频。
样品拉链

Tharwat · 发表于 2022-7-5 18:38:50

我知道你肯定可以管理剩下的代码

copy


(if (and (setq s (car (entsel "\nSelect any object :")))
        (wcmatch (cdr (assoc 0 (setq e (entget s))))
                 "LINE,*POLYLINE,CIRCLE,ARC")
        )
 (progn
   (if (cdr (assoc 6 e))
     (setvar 'CELTYPE (cdr (assoc 6 e)))
     (setvar 'CELTYPE "ByLayer")
     )
   (if (cdr (assoc 62 e))
     (setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
     (setvar 'CECOLOR "ByLayer")
     )
   )
 )

ttray33y · 发表于 2022-7-5 18:39:58

这将是一个良好的开端。。非常感谢我的朋友。

Tharwat · 发表于 2022-7-5 18:43:36

欢迎您，祝您在编码之旅中好运。
当你遇到障碍时询问。

prodromosm · 发表于 2022-7-5 18:46:08

嗨，ttray33y。你重新创建代码了吗？你能贴出来吗？

iconeo · 发表于 2022-7-5 18:49:48

copy

(defun c:qwremake ()
 (if (and (setq s (car (entsel "\nSelect any object: ")))
   (wcmatch (cdr (assoc 0 (setq e (entget s))))
            "LINE,*POLYLINE,CIRCLE,ARC"
   )
     )
   ;; This will set the properties for lines, polylines, circles and arcs
   (progn
     ;; linetype
     (if (cdr (assoc 6 e))
(setvar 'CELTYPE (cdr (assoc 6 e)))
(setvar 'CELTYPE "ByLayer")
     )
     ;; layer
     (if (cdr (assoc 8 e))
(setvar 'CLAYER (cdr (assoc 8 e)))
     )
     ;; color
     (if (cdr (assoc 62 e))
(setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
(setvar 'CECOLOR "ByLayer")
     )
     ;; Now we run the command to recreate the same object type
     (command comm (cdr (assoc 0 (setq e (entget s)))))
   )
 )
)

我似乎无法使用多段线。有什么好处？还有，我的方向对吗？

我计划下一步为blocks添加功能。

顺便说一句，我一直在使用李Mac的lisp来帮助确定assoc代码。可以在这里找到。

Tharwat · 发表于 2022-7-5 18:53:53

你好，iconeo，

如果层名称有值，则无需检查层名称，因为在这种情况下它应该始终有值。
我想你在我的原始代码中添加了一个额外的单词。

iconeo · 发表于 2022-7-5 18:55:46

谢谢你的信息。这是我的更新。

copy

(defun c:qwremake ()
 (if (and (setq s (car (entsel "\nSelect any object: ")))
   (wcmatch (cdr (assoc 0 (setq e (entget s))))
            "LINE,*POLYLINE,CIRCLE,ARC"
   )
     )
   ;; This will set the properties for lines, polylines, circles and arcs
   (progn
     ;; layer
     (setvar 'CLAYER (cdr (assoc 8 e)))
     ;; linetype
     (if (cdr (assoc 6 e))
(setvar 'CELTYPE (cdr (assoc 6 e)))
(setvar 'CELTYPE "ByLayer")
     )
     ;; color
     (if (cdr (assoc 62 e))
(setvar 'CECOLOR (itoa (cdr (assoc 62 e))))
(setvar 'CECOLOR "ByLayer")
     )
     ;; polyline width
     (if (cdr (assoc 43 e))
(setvar 'PLINEWID (cdr (assoc 43 e)))
     )
     ;; Now we run the command to recreate the same object type.
     (if (wcmatch (cdr (assoc 0 (setq e (entget s))))
           "LINE,CIRCLE,ARC"
  )
(command comm (cdr (assoc 0 (setq e (entget s)))))
(command "pline")
     )
   )
 )
)

现在来解决方块处理。关于如何使用assoc过滤块，有什么帮助吗？

干杯

[编程交流] 请求-重新创建此lisp

发表回复

精选推荐