【已完成】获取所有图块包括嵌套块（多重块）内圆的圆心坐标（当前坐标系下的值）

jxphklibin · 发表于 2009-1-12 16:27

本帖最后由作者于 2009-2-4 23:59:19 编辑

请大家修改一下程序，在取得块中圆心的时候，对于嵌套块，圆心就偏差了，如何修改才能实现采集嵌套块中的圆心坐标不产生偏离？谢谢！！
[CODE][font=courier new]
(defun AllEntityInBlkdef (blk / bn blkdef e typ el )
(setq bn (cdr (assoc 2 (entget blk)))
blkdef (tblobjname "block" bn)
)
(while (setq e (entnext blkdef))
(setq typ (cdr (assoc 0 (entget e))))
(if (= typ "INSERT")
(setq el (append (AllEntityInBlkdef e) el))
(setq el (cons e el))
)
(setq blkdef e)
)
el
)
(defun c:AentinBl (/ i en ss entlst ABentlst) ;bn) if while repeat 三函数 foreach
(setq ss (ssget '((0 . "INSERT")))
ABentlst '()
)
(if ss
(repeat (setq i (sslength ss))
(setq en (ssname ss (setq i (1- i)))
entlst (AllEntityInBlkdef en)
ABentlst (append (list (list (cons en (length entlst)) entlst)) ABentlst)
)
;;(princ (strcat "该块内共有" (itoa (length entlst)) "个实体\n"))
)
(princ "*** 你没有选择任何图块 ***")
)
(princ ABentlst)
;;返回的结果(((第i个图块图元名 . 块内实体图元数) (<图元名: 7ef771b0>...)) ...)
;;; (princ)
)
;; 获取图块（包括嵌套块）内所圆的有圆心坐标，返回圆心坐标组成的表：(pt0 pt1 pt2 ... ptn)
(defun c:GetBlockCircen (/ Par_list Par_Item
Par_ent Par_ent_insPtptcenlst
Sub_list Out_LoopN In_LoopN
ent entdata CenPt
)
(setq Par_list (c:AentinBl)
ptcenlst '()
)
;;循环
(repeat (setq Out_LoopN (length Par_list))
(setq Par_Item (nth (setq Out_LoopN (1- Out_LoopN)) Par_list)
Par_ent (car (car Par_Item))
Par_ent_insPt (cdr (assoc 10 (entget Par_ent)))
Sub_list (car (cdr Par_Item))
)
(foreach ent Sub_list
(setq entdata (entget ent))
(if (= (cdr (assoc 0 entdata)) "CIRCLE")
(setq CenPt (trans (trans (cdr (assoc 10 entdata)) Par_ent 1) 1 0);OCS坐标系(distance Par_ent_insPt '(0 0))
ptcenlst (append
ptcenlst
(list (list (+ (car Par_ent_insPt) (car CenPt))
(+ (cadr Par_ent_insPt) (cadr CenPt))
(+ (caddr Par_ent_insPt) (caddr CenPt))
);仅对单层图块或插入点重合在一点嵌套块适用
)
)
)
;;取得的是世界坐标值(不一定，要看块的插入点？还是建立块的时候的坐标系情况？)，使用的时候需要再转换为用户坐标值
;;经过测试，取得坐标值，与图块的插入点相关,所以上面加上块的插入点偏移值
)
)
)
(command "pline"
(foreach i (trans_pt_0->1 ptcenlst) (command i))
;;; ""
) ;该语句实现，由点表画线
(princ ptcenlst)
(princ)
)
;;; ****************************************************
;;; 坐标点由世界坐标系转换到用户坐系 2007.6.10
;;; ****************************************************
(defun trans_pt_0->1 ( ptlst / )
(mapcar '(lambda (x) (trans x 0 1)) ptlst)
)
(defun trans_pt_1->0 ( ptlst / )
(mapcar '(lambda (x) (trans x 1 0)) ptlst)
)
;;先取得块里有多少个子块，然后逐一用VAL-GET-LAYER就好了。（VLA-GET-LAYER（VLA-ITEM BLKOBJ I））
[/FONT][CODE]

请大家修改一下程序，在取得块中圆心的时候，对于嵌套块，圆心就偏差了，如何修改才能实现采集嵌套块中的圆心坐标不产生偏离？谢谢！！
[CODE][font=courier new]
(defun AllEntityInBlkdef (blk / bn blkdef e typ el )
  (setq bn     (cdr (assoc 2 (entget blk)))
 blkdef (tblobjname "block" bn)
  )
  (while (setq e (entnext blkdef))
    (setq typ (cdr (assoc 0 (entget e))))
    (if (= typ "INSERT")
      (setq el (append (AllEntityInBlkdef e) el))
      (setq el (cons e el))
    )
    (setq blkdef e)
  )
  el
)
(defun c:AentinBl (/ i en ss entlst ABentlst) ;bn) if while repeat 三函数 foreach
  (setq ss  (ssget '((0 . "INSERT")))
 ABentlst '()
  )
  (if ss
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
     entlst   (AllEntityInBlkdef en)
     ABentlst (append (list (list (cons en (length entlst)) entlst)) ABentlst)
      )
      ;;(princ (strcat "该块内共有" (itoa (length entlst)) "个实体\n"))
    )
    (princ "*** 你没有选择任何图块 ***")
  )
  (princ ABentlst)
  ;;返回的结果(((第i个图块图元名 . 块内实体图元数) (<图元名: 7ef771b0>...)) ...)
;;;  (princ)
)
;; 获取图块（包括嵌套块）内所圆的有圆心坐标，返回圆心坐标组成的表：(pt0 pt1 pt2 ... ptn)
(defun c:GetBlockCircen (/        Par_list      Par_Item
    Par_ent       Par_ent_insPtptcenlst
    Sub_list      Out_LoopN     In_LoopN
    ent        entdata      CenPt
   )
  (setq Par_list (c:AentinBl)
 ptcenlst '()
  )
  ;;循环
  (repeat (setq Out_LoopN (length Par_list))
    (setq Par_Item (nth (setq Out_LoopN (1- Out_LoopN)) Par_list)
   Par_ent (car (car Par_Item))
   Par_ent_insPt (cdr (assoc 10 (entget Par_ent)))
   Sub_list (car (cdr Par_Item))
    )
    (foreach ent Sub_list
      (setq entdata (entget ent))
      (if (= (cdr (assoc 0 entdata)) "CIRCLE")
 (setq CenPt    (trans (trans (cdr (assoc 10 entdata)) Par_ent 1) 1 0);OCS坐标系(distance Par_ent_insPt '(0 0))
       ptcenlst (append
    ptcenlst
    (list (list (+ (car Par_ent_insPt) (car CenPt))
         (+ (cadr Par_ent_insPt) (cadr CenPt))
         (+ (caddr Par_ent_insPt) (caddr CenPt))
          );仅对单层图块或插入点重合在一点嵌套块适用
    )
         )
 )
 ;;取得的是世界坐标值(不一定，要看块的插入点？还是建立块的时候的坐标系情况？)，使用的时候需要再转换为用户坐标值
 ;;经过测试，取得坐标值，与图块的插入点相关,所以上面加上块的插入点偏移值
      )
    )
  )
  (command "pline"
    (foreach i (trans_pt_0->1 ptcenlst) (command i))
;;;    ""
  )     ;该语句实现，由点表画线
  (princ ptcenlst)
  (princ)
)
;;; ****************************************************
;;; 坐标点由世界坐标系转换到用户坐系  2007.6.10
;;; ****************************************************
(defun trans_pt_0->1 ( ptlst / )
  (mapcar '(lambda (x) (trans x 0 1)) ptlst)
)
(defun trans_pt_1->0 ( ptlst / )
  (mapcar '(lambda (x) (trans x 1 0)) ptlst)
)
;;先取得块里有多少个子块，然后逐一用VAL-GET-LAYER就好了。（VLA-GET-LAYER（VLA-ITEM BLKOBJ I））
[/FONT][CODE]

程序已经完成，采用了多种方法，有两种方法对任意情况的图块均得出正确的值。

复制代码

liumangxx · 发表于 2012-11-26 17:25

强大无比啊

liumangxx · 发表于 2012-11-26 17:25

再顶太有用了

liumangxx · 发表于 2012-11-26 17:26

改好了？？？？？？？？

liumangxx · 发表于 2012-11-26 17:27

程序有点看不懂啊 55 水平菜啊我

liumangxx · 发表于 2012-11-26 17:27

为什么神贴都没人来顶？我再顶2

liumangxx · 发表于 2012-11-26 17:28

其实我要刷帖数啊

liumangxx · 发表于 2012-11-26 17:28

呵呵这个帖子不错楼主强大

liumangxx · 发表于 2012-11-26 17:29

心怀敬仰啊！！！！！！！

账号		自动登录	找回密码
密码			注册