社区 › Auto Lisp › 请求-重新创建此lisp

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

请求-重新创建此lisp

嗨，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

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

(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

(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

 
谢谢你的信息。这是我的更新。
 
(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