社区 › Auto Lisp › 批量拆离影像

yangqingchao 发表于 2018-6-16 16:29:00

批量拆离影像

复制代码
(prompt "本程序执行命令是: DetachIMG\n")
(defun cetachIMG ( / imageDict ss1 ss2 num lst newlst n blkName fileList)
(setvar "cmdecho" 0)
(setq ss1 (X:flists))
(setq imageDict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))
(setq num (length imageDict))
(setq lst (XD:ist:Nth++ imageDict 10 (- num 10)))
(setq newlst (XD:IST:Group-n lst 2))
(setq n (length newlst))
(while (vla-object ee))
      (setq *fullName (vla-get-ImageFile vlaobj))
      ;(setq *fileName (strcat (vl-filename-base *fullName) (vl-filename-extension *fullName)))
      (setq filelists (cons *fullName filelists))
      )
    )   
)
(vl-sort filelists '= n (length l)) l)
            ((< n (- (length l) n))
               (repeat (/ n 4)
                   (setq s (cons (cadddr l)
                                 (cons (caddr l) (cons (cadr l) (cons (car l) s)))
                           )
                         l (cddddr l)
                   )
               )
               (repeat (rem n 4)
                   (setq s (cons (car l) s)
                         l (cdr l)
                   )
               )
               (reverse s)
            )
            (t
               (setq l (reverse l)
                     s (- (length l) n)
               )
               (repeat (/ s 4) (setq l (cddddr l)))
               (repeat (rem s 4) (setq l (cdr l)))
               (reverse l)
            )
      )
      l
    )
)
;;;此函数来自晓东CAD
(defun XD:IST:Group-n ( l n / a b )
    (while l
      (repeat n
            (setq a (cons (car l) a)
                  l (cdr l)
            )
      )
      (setq b (cons (reverse a) b)
            a nil
      )
    )
    (reverse b)
)

paulpipi 发表于 2018-6-16 21:34:00

谢谢分享

flowerson 发表于 2022-7-26 19:15:00

不用command 用vlisp 怎样写呢？

查看完整版本: 批量拆离影像