块图元增加或者减少

自贡黄明儒

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;击块内一个图元(属性除外)，如果再选择一个图元，则加入块；如果没有
;;;;;;再选择一个图元，则所击块内图元将被删除。
(defun c:BlockObjectRA (/ BLOCKOBJECT SS)
  (setq BlockObject
  (lt:entsel "\n请击块中要删除的一个图元："
      '((0 . "insert") (100 . "AcDbBlockReference"))
      (list "对象必须是块内对象，属性除外" "")
  ) ;_ end of lt:entsel
  ) ;_ end of setq   
(setq InsertPoint (cdr (assoc 10 (entget (car BlockObject)))))

  (setq ss (entsel "\n选择图元则加入块，回车则删除所击的块中图元:"))

  (if (and BlockObject ss)
    (BlockObjectAdd BlockObject ss)
    (BlockObjectRemove BlockObject)
  ) ;_ end of if

) ;_ end of defun

;;;说明：本函数用块名重新定义一个块，sst 为图元名表，blkn为已存在的块名.
;;;(实体表 块名 插入点)
(defun make-a-block (sst blkn inp / BLKLST COUNT ENTLIST OSM TAG)

  (setq osm (getvar "osmode"))  ;获取用户捕捉
  (setvar "osmode" 0)

  (setq tag (getvar "ucsorg"))
  (setq inp (list (- (car inp) (car tag))
    (- (cadr inp) (cadr tag))
    (- (caddr inp) (caddr tag))
     ) ;_ end of list
) ;_ end of setq
  (setq count 0)
  (setq blklst (ssadd))
  (repeat (length sst)
    (setq entlist (entget (nth count sst)))
    (setq count (1+ count))
    (entmake entlist)
    (ssadd (entlast) blklst)
  ) ;_ end of repeat
  (command "block" blkn "y" inp blklst "")

  (setvar "osmode" osm)
) ;_ end of defun
;;;

;;;块内对象删除
(defun BlockObjectRemove
       (BlockObject / ENTLST FIRN FIRNLST SUBLST SUBNAME)
  (command "undo" "be")

  (setq entlst (entget (car BlockObject)))
  (setq sublst (nentselp "" (cadr BlockObject)))
  (setq subname (car sublst))  ;块中一个元素,可以entget访问
  (if (> (length sublst) 2)
    (progn
      (setq firn   ;firn 为图元名
      (cdr (assoc -2  ;
    (tblsearch "block" (cdr (assoc 2 entlst)))
     ;tblsearch+"block"+块名
    ) ;_ end of assoc
      ) ;_ end of cdr
      ) ;_ end of setq
      (setq firnlst (list ()))
      (while firn
 (if (not (eq firn subname)) ;本句滤去选择的那一图元
   (setq firnlst (append firnlst (list firn)))
 ) ;_ end of if
 (setq firn (entnext firn))
      ) ;_ end of while此循环，不然整个块将删除;将块内各图元素（均可entget访问)列成表，前加nil

      (make-a-block
 (cdr firnlst)
 (cdr (assoc 2 entlst))  ;块名
 '(0 0 0)
      ) ;_ end of make-a-block

    ) ;_ end of progn
    (alert "\n所选择的可能是属性，删不了！")
  ) ;_ end of if
  (command "undo" "e")
) ;_ end of defun
;;;

;;;块内增加对象
(defun BlockObjectAdd
        (BlockObject ss / ENTLST FIRN FIRNLST)
  (command "undo" "be")
  (setq entlst (entget (car BlockObject)))
  (setq firn    ;firn 为图元名
  (cdr (assoc -2   ;
       (tblsearch "block" (cdr (assoc 2 entlst)))
     ;tblsearch+"block"+块名
       ) ;_ end of assoc
  ) ;_ end of cdr
  ) ;_ end of setq
  (setq firnlst (list ()))
  (while firn
    (setq firnlst (append firnlst (list firn)))
    (setq firn (entnext firn))
  ) ;_ end of while此循环，将块内各图元素（均可entget访问)列成表，前加nil
 
  (setq firnlst (append firnlst (list (car ss))))

  (make-a-block
    (cdr firnlst)
    (cdr (assoc 2 entlst))  ;块名
    '(0 0 0)
  ) ;_ end of make-a-block

  (command "erase" ss "")
  (command "undo" "e")
) ;_ end of defun
;;;

 

(princ "\n本程序根据英雄无敌程序改编,块内加入图元不会改变块内属性值，但也有一个缺点，加入的图元离块很远，望高手解决之。")

danxingpen

运行不了，至于加入的图元离块很远估计就是插入点的问题，需要对要添加的图元进行几何变换（或者说矩阵变换）。相信如果那个块插入点在原点的话，添加的图元就应该可以在原位了，呵呵！

也就是说简单点可以先把选择的块和选择的图元一起从块的插入点移动到原点，然后在进行图元的添加，然后再移动块到原来的点，这样就不用进行麻烦的变换了！

自贡黄明儒

  (lt:entsel "\n请击块中要删除的一个图元："
      '((0 . "insert") (100 . "AcDbBlockReference"))
      (list "对象必须是块内对象，属性除外" "")
  ) ;_ end

这是在本论坛下载的，改一改就可运行了。

（entsel "\n请击块中要删除的一个图元："）

如果说几何变换，那就麻烦了，我的高数都忘得差不多了。

我试过修改最后加入图元的定位点，还是有问题..