堆栈在一起的像素,怎么做筛选复制?(已解決!!谢谢)

lincctw_ccl

各位好!!

小弟有些图是堆栈在一起的!在这下载到一个源码是可将其拆出并复制到指定位置上去,这程序是以层来做拆图 但小弟的图层名是有关连性的,请教有位高手能帮小弟改一下这个程序!! 谢谢

例: 我的图层有 A ,A01,A33,ADIM ,B ,B01,B33,BDIM…….等

如何将 A ,A01,A33,ADIM 拆出在一起

将 B ,B01,B33,BDIM 拆出在一起

注:下面源码如改成我需求的那种有问题,可否帮小弟改成 由”使用者定义图层” 例 输入 a 那会全部复制 A ,A01,A33,ADIM 的图层,

谢谢

 

以下为源码:

 

*************************

(defun c:FC (/ ss p1 p2 p3)

    (princ "图层分离====")

            (setq p2 (getpoint "请点选左下角最外围的点:   "))

            (setq p3 (getpoint "请点选右上角最外围的点:   "))

            (setq p1 (getpoint "确定分离的位置点:"))

            (command "cmdecho" "0")

            (command "osnap" "none" nil)

            (setq ss (ssget "w" (list (car p2) (cadr p2))  

                               (list (car p3) (cadr p3))

                      )

               )

            (while ss

              (setq n 0)

             (while (>= (sslength ss) 1)

                     (setq ee (ssname ss 0))

                     (setq la (cdr (assoc 8 (entget ee))))

                     (setq s (ssget "w" (list (car p2) (cadr p2))  

                               (list (car p3) (cadr p3))

                               )

                      )

                    (while s

                     (setq s1 (ssadd))

                     (setq c 0)

                     (while (<= c (- (sslength s) 1))

                       (setq e (ssname s c))

                       (if (= la (cdr (assoc 8 (entget e))))

                           (progn

                              (ssadd e s1)

                             (ssdel (handent (cdr (assoc 5 (entget e)))) ss)

                           )

                          )

                        (setq c (+ 1 c))

                          )

                    (setq s nil)

                      )

                       (setq sc (- (cadr p3) (cadr p2)))

                      (if (>= n 7)

                         (setq pt1 (list (+ (car p1) (- (car p3) (car p2)))

                                         (+ (cadr p1) (* (+ sc 30) (- n 6)))

                       ))

                      (if (< n 7)

                        (setq pt1 (list (car p1)

                                        (+ (cadr p1) (* (+ sc 30) n)))

                                 )

                          )

                       )

                      (command "text" "s" "standard" pt1 "10" "" la nil)

                     (command "copy" s1 "" p2 pt1 nil)

                     (setq n (+ n 1))

                )

     (setq ss nil)      )

 

(princ"\  (图层成功分离!)")(princ))

*********************************************************************************************

danxingpen

(defun c:FC (/ ss p1 p2 p3 )
  (princ "图层分离====")
  (setq p2 (getpoint "请点选左下角最外围的点:   "))
  (setq p3 (getpoint "请点选右上角最外围的点:   "))
  (setq p1 (getpoint "确定分离的位置点:"))
  (setq layer(strcase(getstring "\n使用者定义图层:")))
  ;(command "cmdecho" "0")
  ;(command "osnap" "none" nil)
  (setq ss (ssget "w" (list (car p2) (cadr p2)) (list (car p3) (cadr p3)) (list (cons 8 (strcat layer "*")))))
  (if ss
    (progn
      (command "copy" ss "" p2 p2)
      (command "move" ss "" p2)
      ))
)

 

(defun c:FC (/ ss p1 p2 p3 )
  (princ "图层分离====")
  (setq p2 (getpoint "请点选左下角最外围的点:   "))
  (setq p3 (getpoint "请点选右上角最外围的点:   "))
  (setq p1 (getpoint "确定分离的位置点:"))
  (while (/= "" (setq layer(strcase(getstring "\n使用者定义图层:"))))
    (setq ss (ssget "w" (list (car p2) (cadr p2)) (list (car p3) (cadr p3)) (list (cons 8 (strcat layer "*")))))
    (if ss
    (progn
      (command "copy" ss "" p2 p2)
      (command "move" ss "" p1 pause)
      ))
  )
  (princ)
  ;(command "cmdecho" "0")
  ;(command "osnap" "none" nil)
)

lincctw_ccl

 

谢谢您!!

这就是我要的执行结果