【e派】Z轴归零问题探讨——源码揭秘

本帖最后由 xyp1964 于 2014-5-8 14:53 编辑

属性块内的属性文本：

普通块内的实体：

;; 先从简单的开始

;; Z轴归零主函数 zzgl
;; 实例: (zzgl (setq s1 (car (entsel "\n选择: "))))
(defun zzgl (s1)
;; 适合于一般实体
(foreach a '(10 11 12 13 14)
(zzgl-dxf s1 a)
)
)
;; __________________________________________________________________
;; 以下为自定义函数，大部分代码都曾经开源过
;; __________________________________________________________________
(defun xyp-DXF (code s1 / ent lst a)
(if (= (type code) 'LIST)
(progn
(setq ent (entget s1)
lst '()
)
(foreach a code
(setq lst (cons (list a (cdr (assoc a ent))) lst))
)
(reverse lst)
)
(if (= code -3)
(cdr (assoc code (entget s1 '("*"))))
(cdr (assoc code (entget s1)))
)
)
)
(defun xyp-Etype (s1 etype)
(wcmatch (xyp-DXF 0 s1) (strcase etype))
)
(defun xyp-SubUpd (s1 code val / ent x y i s1)
(cond ((= (type s1) 'ENAME)
(setq ent (entget s1))
(if (and (= (type code) 'LIST) (= (type val) 'LIST))
(mapcar '(lambda (x y) (xyp-SubUpd s1 x y)) code val)
(progn
(if (= (xyp-dxf code s1) nil)
(entmod (append ent (list (cons code val))))
(entmod (subst (cons code val) (assoc code ent) ent))
)
(entupd s1)
)
)
)
((= (type s1) 'PICKSET)
(setq i -1)
(while (setq s2 (ssname s1 (setq i (1+ i))))
(xyp-SubUpd s2 code val)
)
)
((= (type s1) 'LIST)
(foreach s2 s1 (xyp-SubUpd s2 code val))
)
)
s1
)
(defun zzgl-dxf (s1 mode / pt)
(if (and (setq pt (xyp-dxf mode s1))
(/= (caddr pt) 0)
)
(xyp-SubUpd s1 mode (list (car pt) (cadr pt) 0))
)
)
;; __________________________________________________________________
;; 自定义函数
;; __________________________________________________________________

;; Z轴归零主函数 zzgl 
;; 实例: (zzgl (setq s1 (car (entsel "\n选择: ")))) 
(defun zzgl (s1) 
  ;; 适合于一般实体 
  (foreach a '(10 11 12 13 14) 
    (zzgl-dxf s1 a) 
  ) 
) 
;; __________________________________________________________________ 
;; 以下为自定义函数，大部分代码都曾经开源过 
;; __________________________________________________________________ 
(defun xyp-DXF (code s1 / ent lst a) 
  (if (= (type code) 'LIST) 
    (progn 
      (setq ent (entget s1) 
            lst        '() 
      ) 
      (foreach a code 
        (setq lst (cons (list a (cdr (assoc a ent))) lst)) 
      ) 
      (reverse lst) 
    ) 
    (if (= code -3) 
      (cdr (assoc code (entget s1 '("*")))) 
      (cdr (assoc code (entget s1))) 
    ) 
  ) 
) 
 
(defun xyp-Etype (s1 etype) 
  (wcmatch (xyp-DXF 0 s1) (strcase etype)) 
) 
 
(defun xyp-SubUpd (s1 code val / ent x y i s1) 
  (cond ((= (type s1) 'ENAME) 
         (setq ent (entget s1)) 
         (if (and (= (type code) 'LIST) (= (type val) 'LIST)) 
           (mapcar '(lambda (x y) (xyp-SubUpd s1 x y)) code val) 
           (progn 
             (if (= (xyp-dxf code s1) nil) 
               (entmod (append ent (list (cons code val)))) 
               (entmod (subst (cons code val) (assoc code ent) ent)) 
             ) 
             (entupd s1) 
           ) 
         ) 
        ) 
        ((= (type s1) 'PICKSET) 
         (setq i -1) 
         (while (setq s2 (ssname s1 (setq i (1+ i)))) 
           (xyp-SubUpd s2 code val) 
         ) 
        ) 
        ((= (type s1) 'LIST) 
         (foreach s2 s1 (xyp-SubUpd s2 code val)) 
        ) 
  ) 
  s1 
) 
 
(defun zzgl-dxf (s1 mode / pt) 
  (if (and (setq pt (xyp-dxf mode s1)) 
           (/= (caddr pt) 0) 
      ) 
    (xyp-SubUpd s1 mode (list (car pt) (cadr pt) 0)) 
  ) 
) 
;; __________________________________________________________________ 
;; 自定义函数 
;; __________________________________________________________________

网友答: ;; spline、arc 、块内实体、dxf 210码不正常等等的实体——待后续研究

;; zzgl(Z轴归零)
;; 测试实例
(defun c:zzgl ()
(princ "\n选择归零实体: ")
(if (setq ss (ssget))
(setq lst (xyp-Ss2List ss)
lst (mapcar 'xyp-Zzgl lst)
)
)
(princ)
)
;; Z轴归零主函数 xyp-Zzgl
(defun xyp-Zzgl (s1 / p10)
;; 属性块实体: 先移位后属性实体归零
(if (and (xyp-Etype s1 "insert")
(= (xyp-Dxf 66 s1) 1)
)
(progn
(setq p10 (xyp-Dxf 10 s1))
(xyp-Move s1 p10 (list (car p10) (cadr p10) 0))
(foreach ob (xyp-AttList s1)
(xyp-Zzgl (vlax-vla-object->ename ob))
)
)
)
;; 一般实体
(foreach a '(10 11 12 13 14)
(xyp-Zzgl-Dxf s1 a)
)
;; 有38码的实体
(if (/= (setq pt (xyp-Dxf 38 s1)) 0)
(xyp-SubUpd s1 38 0)
)
;; spline实体、arc 实体、块内实体、dxf 210码不正常的实体
)

网友答: 用的天正自带的坐标归零。这个试了后，发现上传的测试图图案填充还有一些块无法坐标归零。

网友答:

ko217 发表于 2015-5-26 21:53
有块不炸开就归零的吗

期待啊

网友答:

院长厉害......垃圾处理利器

网友答: 看得见摸不着哦

网友答:

院长厉害

网友答: 期待院长的源码发放……

我的图就是这鬼样的

网友答: 有程序共享不，图多了会不会致命错误

网友答:

;; Z轴归零主函数 zzgl
;; (zzgl (setq s1 (car (entsel "\n选择: "))))
(defun zzgl (ename)
;; 适合于一般实体
(foreach a '(10 11 12 13 14)
(zzgl-dxf ename a)
)
;; 存在38码的实体
(if (/= (setq pt (xyp-dxf 38 ename)) 0)
(xyp-SUBUPD ename 38 0)
)
)

网友答: 火前留名。。。

网友答:

院长厉害！

网友答: 这个确实很实用，顶院长！

上一篇：【飞鸟集】数据取整（更新至2020.10）

下一篇：没有了