程序求修改

孙海波

我在站内找到一个程序，可以实现框选范围内的块全部变为匿名块，但是有一个问题，只要遇到属性块就不行了，希望大家修改。
程序附后：



(defun c:gk (/ ss lst-ename lst-b x y ss-c)
  (vl-load-com)
  (setvar "CMDECHO" 0)
;;;选择框选范围内的所有块
(setq ss (ssget '((0 . "INSERT"))))
;;; 定义将选择集转化为对象图元名列表
  (defun ss-enamelst (ss)
    (vl-remove-if-not
      '(lambda (x) (equal (type x) 'ename))
      (mapcar 'cadr (ssnamex SS))
    )
  )
;;;end defun

;;; 将块选择集转化为图元名列表
  (setq lst-ename (ss-enamelst ss))
;;; 通过 ssget "WP" 将多线段和多线段内部的对象（可以再加上过滤，过滤掉非园）组成一个表
  (setq
    lst-b
     (mapcar '(lambda (x)
    (progn
;;; 多线段端点列表内部窗选
      (setq  ss-c (ssget "WP"
            (apply
              'append
              (mapcar '(lambda (y)
             (if (eq (car y) 10)
               (list (cdr y))
             )
                 )
                (entget x)
              )
            )
           )
      )
;;;判断选择集是否存在。也可以加入其它的判断
      (if (null ss-c)
        (list x)
        (append (list x) (ss-enamelst ss-c))
      )
    )      ;end progn
        )        ;end lambda
       lst-ename
     )
  )
;;;生成无名块并删除原有对象
  (mapcar '(lambda (x)
       (progn
         (entmakenonameblock x (cdr (assoc 10 (entget (car x)))))
         (mapcar '(lambda  (y)
        (vl-cmdf "erase" y "")
      )
           x
         )
       )
     )
    lst-b
  )


  (prin1)
)
;;;; 图元列表生成无名快
(defun entmakenonameblock (lst pt / i name)
  (entmake
    (list '(0 . "block") '(2 . "*U") '(70 . 1) (cons 10 pt))
  )
  (mapcar '(lambda (x) (entmake (cdr (entget x)))) lst)
  (setq name (entmake '((0 . "ENDBLK"))))
  (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
  name
)

pzweng

(defun c:gk (/ ss lst-ename lst-b x y ss-c)
  (vl-load-com)
  (setvar "CMDECHO" 0)
;;;选择框选范围内的所有块
  (setq ss (ssget '((0 . "INSERT"))))
;;; 定义将选择集转化为对象图元名列表
  (defun ss-enamelst (ss)
    (vl-remove-if-not
      '(lambda (x) (equal (type x) 'ename))
      (mapcar 'cadr (ssnamex ss))
    )
  )
;;;end defun

;;; 将块选择集转化为图元名列表
  (setq lst-ename (ss-enamelst ss))
;;; 通过 ssget "WP" 将多线段和多线段内部的对象（可以再加上过滤，过滤掉非园）组成一个表
  (setq
    lst-b
     (mapcar '(lambda (x)
                (progn
;;; 多线段端点列表内部窗选
                  (setq        ss-c (ssget "WP"
                                    (apply
                                      'append
                                      (mapcar '(lambda (y)
                                                 (if (eq (car y) 10)
                                                   (list (cdr y))
                                                 )
                                               )
                                              (entget x)
                                      )
                                    )
                             )
                  )
;;;判断选择集是否存在。也可以加入其它的判断
                  (if (null ss-c)
                    (list x)
                    (append (list x) (ss-enamelst ss-c))
                  )
                ) ;end progn
              ) ;end lambda
             lst-ename
     )
  )
;;;生成无名块并删除原有对象
  (mapcar '(lambda (x)
             (progn
               (entmakenonameblock x (cdr (assoc 10 (entget (car x)))))
               (mapcar '(lambda        (y)
                          (vl-cmdf "erase" y "")
                        )
                       x
               )
             )
           )
          lst-b
  )


  (prin1)
)
;;;; 图元列表生成无名快
(defun entmakenonameblock (lst pt / i name)
  (entmake (list '(0 . "block") '(2 . "*U") '(70 . 1) (cons 10 pt)))
  (mapcar '(lambda (x) (entmake (cdr (entget x)))) lst)
  (entmake '((0 . "SEQEND")))
  (setq name (entmake '((0 . "ENDBLK"))))
  (entmake (list '(0 . "INSERT") (cons 2 name) (cons 10 pt)))
  name
)

孙海波

pzweng 发表于 2023-4-18 14:27
(defun c:gk (/ ss lst-ename lst-b x y ss-c)
  (vl-load-com)
  (setvar "CMDECHO" 0)

不行，属性块里面的文字不见了

ssyfeng

如果有问题，可以上传dwg文件测试