怎么用ssnamex获得多个选择区域，并重新选择这些区域

陈伟

(defun c:tt () ; tt(批量框选拉伸)
  (setq n 0 lst '())
  (princ "\n请选择第 1 个选择集<退出>: ")
  (while (set (setq aa (read (strcat "ss" (itoa (setq n (1+ n))))))(ssget ":s"  ))
    (setq lst (cons aa lst))
    (princ (strcat "\n请选择第 " (itoa (1+ n)) " 个选择集<退出>: "))
  )
  (setq lst (append '(command ".stretch") lst '("" pause pause)))
  (eval lst)
  (princ)
)



填充图案拉伸（目的是代替CAD自带拉伸命令）
已写了一个图案拉伸工具，但是感觉还不够完美，原帖http://bbs.mjtd.com/thread-181607-1-1.html


下面这个程序只能实现单次选择，而且取消选择时线条和多段线不能取消，有大神能够帮忙实现像CAD自带拉伸工具一样自由选择取消吗（ssnamex获得多个选择区域，并重新选择这些区域）！！！本人小白一个，对LISP不懂，这些都是我从网络搜集拼凑在一起的！！！

(defun C:S123( )


(setq xyxyxy (last (ssnamex (setq ss (ssget)) 0)))  ;;获得ssget选择集的一个信息表。
(setq xt (last (cadr xyxyxy)) yt (last (cadddr xyxyxy)))     ;;提取刚才的窗选对角坐标。
(setq xt (trans xt 0 1)
      yt (trans yt 0 1)
)



(setq old_lay (getvar "clayer")) ;保存当前图层
   (setq layer "TC填充图案边界线")
        (if (not (tblsearch "layer" layer ))
        (progn   (command "layer" "new" "TC填充图案边界线" "s" "TC填充图案边界线" "C" 231 "" "L" "Continuous" "" "P" "N" "" "LW" 0"" "") )  );新建图层
  (COMMAND "clayer" layer) ;置当前图层

(setq sg (ssget "P" '((0 . "HATCH")) ) i -1 );过滤对象只选填充图案
  (if sg (while (setq s1 (ssname sg (setq i (1+ i))));批量生成填充边界
    (command "-hatchedit" s1 "b" "p" "y") ))
(setvar "clayer" old_lay) ;恢复原先图层

(setq s2 (ssget "c" xt yt ))
(command ".STRETCH" S2 "" pause pause)   ;;


(setq sggg (ssget "A"  '((8 . "TC填充图案边界线"))))
(COMMAND "_.erase"  sggg "");删除生成的边界线！

  (princ)
)

lxl217114

顶一下，看看有没有大佬出手帮忙

陈伟

lxl217114 发表于 2020-6-4 20:53
顶一下，看看有没有大佬出手帮忙

看着有人留言，我兴奋的打开帖子一看！！！

陈伟

lxl217114 发表于 2020-6-4 20:53
顶一下，看看有没有大佬出手帮忙

看着有人留言，我兴奋的打开帖子一看！！！

陈伟

自己顶一个，经过不断摸索 解决方法如下
(defun C:Sass1( / loop  **loop        )
(defun *error*(msg)
                (setvar "clayer" old_lay);恢复原先图层
                                (setvar "Cecolor" #os6);恢复原先图层特性颜色               
                ;;---------------------------------------------------------------------------------------------------------------       
                  (setq s1220T (ssget"A"(List(cons 420(+(* 180 256 256)(* 106 256)226)))) )                                             
                  (if s1220T (COMMAND-S "_.erase"  (ssget "P"  '((8 . "0")) ) ""));删除生成的边界线！               
        )
(setq old_lay (getvar "clayer")) ;保存当前图层
(setq #os6 (getvar "Cecolor"))  ;保存当前图层特性颜色   
(princ "\n△△请选择△△：除第一个选择框外，其他选择框中的非关联填充图案不会被拉伸")

(setq loop(ssget         ))     ;;选择需要拉伸的填充图案或者其他图元。
(setq xyxyxy (last (ssnamex loop 0)))  ;;获得ssget选择集的一个信息表。
(setq stg (ssget "P" '((0 . "HATCH")) ) );过滤对象只选填充图案
  (if (not stg)(progn(command "SELECT"  "p"  pause ) (command ".STRETCH"  "p"  "" pause pause)    ));;当没有填充图案时直接拉伸
  (if stg (progn
(command "move" stg "" "_NONE" '(100 100) "_NONE" '(100 100))
  (COMMAND "clayer" "0" "cecolor" "RGB:180,106,226" ) ;置0层为当前图层
(setq sg (ssget "P" ) i -1 );选择需要循环生成边界线的填充图案
  (if sg (while (setq s1 (ssname sg (setq i (1+ i))));批量生成填充边界
    (command "-hatchedit" s1 "b" "p" "y")   )) ;批量生成填充边界，选择边界线，后置边界线
(setvar "clayer" old_lay);恢复原先图层
(setvar "Cecolor" #os6);恢复原先图层特性颜色


(setq n 0)
(repeat (sslength  loop)
(setq xyxyxy (last (ssnamex loop n)))  ;;获得ssget选择集的一个信息表。  
(setq xt (last (cadr xyxyxy)) yt (last (cadddr xyxyxy)))     ;;提取刚才的窗选对角坐标。
(setq xt (trans xt 0 1)  yt (trans yt 0 1) )
(setq  ss (ssget "c"  xt  yt ) )
(command ".STRETCH"  "p"  "" pause pause)   ;;
(setq n (1+ n))
) ;endrepeat



(setq ss021TT (ssget"A"(List(cons 420(+(* 180 256 256)(* 106 256)226)))) )
(if ss021TT (COMMAND "_.erase"  (ssget "P"  '((8 . "0")) ) "")    )) );删除生成的边界线！
(princ "\n*********拉伸完毕，欢迎访问明经论坛交流，中联合创设计有限公司滇西分公司制作")
  (princ)
)