拉伸复制功能合并，用DeepSeek实现

183017064

• 

  2. (defun c:ss (/ ss elist)
     
  3.   (setq ss (ssget)) ; 用户框选图元
     
  4.   (setq elist (save_entities ss)) ; 保存原始组码
     
  5.   (initcommandversion 5) ; 启用新版命令
     
  6.   (command "_.stretch" ss "" "_non" pause "_non" pause) ; 执行拉伸命令
     
  7.   (restore_entities elist) ; 重新生成原始图元
     
  8.   (princ)
     
  9. )
     
  10. (defun save_entities (ss / i ent data)
      
  11.   (setq i 0)
      
  12.   (repeat (sslength ss)
      
  13.     (setq ent (ssname ss i))
      
  14.     (setq data (cons (entget ent) data)) ; 包含实体名和所有组码
      
  15.     (setq i (1+ i))
      
  16.   )
      
  17.   (reverse data)
      
  18. )
      
  19. (defun restore_entities (elist)
      
  20.   (foreach ent elist
      
  21.     (entmake (vl-remove-if '(lambda (x) (member (car x) '(-1 5 330))) ent)) ; 过滤系统组码
      
  22.   )
      
  23. )
      
  24. (vl-load-com)
      
  25. (princ "\n::  复制拉伸 :: \n:: 输入 "ss" 启动程序 ::")
      
  26. (princ)

  (defun c:ss (/ ss elist)<br />   (setq ss (ssget)) ; 用户框选图元<br />   (setq elist (save_entities ss)) ; 保存原始组码<br />   (initcommandversion 5) ; 启用新版命令<br />   (command "_.stretch" ss "" "_non" pause "_non" pause) ; 执行拉伸命令<br />   (restore_entities elist) ; 重新生成原始图元<br />   (princ)<br /> )<br /> (defun save_entities (ss / i ent data)<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i))<br />     (setq data (cons (entget ent) data)) ; 包含实体名和所有组码<br />     (setq i (1+ i))<br />   )<br />   (reverse data)<br /> )<br /> (defun restore_entities (elist)<br />   (foreach ent elist<br />     (entmake (vl-remove-if '(lambda (x) (member (car x) '(-1 5 330))) ent)) ; 过滤系统组码<br />   )<br /> )<br /> (vl-load-com)<br /> (princ "\n::  复制拉伸 :: \n:: 输入 "ss" 启动程序 ::")<br /> (princ)
  
  

jezli

真是神器。

moranyuyan

谢谢分享

qazxswk

上个动图，看看其功能是怎样的效果。

wyl605

AI写了不一定好用，要测试过的

183017064

wyl605 发表于 2025-2-16 07:52
AI写了不一定好用，要测试过的

好用的，我发一个测试图看一下

183017064

qazxswk 发表于 2025-2-15 16:16
上个动图，看看其功能是怎样的效果。

我还不会做动图，先发个静态的看看吧