强力Z坐标归零！ 210组码问题还未解决

升级了下我的Z值归零程序，增加了对原来不敢碰的面域，块定义的处理，但是法向非Z轴对齐的对象还有问题。

G版的correct210 函数在我这里报“; 错误: Automation 错误。不能按非统一比例缩放”，所以210段修正功能暂时屏蔽，静待高人解决。

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110013贴中的“要归零的.dwg”已经90%可以处理了。剩下椭圆、210问题未解决。

correct210 源贴：
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=93123

(vl-load-com)
(defun getboundingbox (ename / lb ur)
(vla-getboundingbox
(vlax-ename->vla-object ename)
'lb
'ur
)
(mapcar 'vlax-safearray->list (list lb ur))
)
;;
(defun move-region-to-wcs-plan (ename / obj z)
(setq obj (vlax-ename->vla-object ename))
(if (and
(= "AcDbRegion" (vla-get-objectname obj))
(/= 0.0 (setq z (caddr (car (getboundingbox ename)))))
)
(vla-move obj
(vlax-3d-point (list 0 0 z))
(vlax-3d-point (list 0 0 0))
)
)
)
;; (move-region-to-wcs-plan(car(entsel)))
;; http://bbs.mjtd.com/thread-93123-1-1.html
(defun correct210 (ent / obj za)
(setq obj (vlax-ename->vla-object ent))
(if (and (vlax-property-available-p obj 'normal t)
(not (equal '(0 0 1)
(setq za (vlax-safearray->list
(vlax-variant-value (vla-get-normal obj))
)
)
)
)
)
(vl-catch-all-apply 'vla-put-normal (list obj (vlax-3d-point '(0 0 1))))
;;; (progn
;;; (setq za (vlax-safearray->list
;;; (vlax-variant-value (vla-get-normal obj))
;;; )
;;; )
;;; (vla-transformby
;;; obj
;;; (vlax-tmatrix
;;; (list
;;; (list 1 0 (car za) 0)
;;; (list 0 1 (cadr za) 0)
;;; (list 0 0 (caddr za) 0)
;;; (list 0 0 0 1)
;;; )
;;; )
;;; )
;;; )
)
)
;;
(defun zero-group (e)
(cond
;; 处理 10-14 段，含 Z 坐标且非零组码，设置Z = 0.0
((and (>= (car e) 10)
(<= (car e) 14)
(> (length e) 3)
(/= 0.0 (nth 3 e))
)
(setq c10 (1+ c10))
(cons (car e) (list (cadr e) (caddr e) 0.0))
)
;; 处理 38 段（标高属性）
((and (= (car e) 38) (/= 0.0 (cdr e)))
(setq c38 (1+ c38))
'(38 . 0.0)
)
;; 其余组码原样返回
(t e)
)
)
(defun zero-ent (e / dxf new)
;;(correct210 e)
(setq dxf (entget e))
(if (= (cdr (assoc 0 dxf)) "REGION")
(move-region-to-wcs-plan e)
(progn
(setq new (mapcar 'zero-group dxf))
(if (not (equal dxf new))
(entmod new)
)
)
)
new
)
(defun zero-block (/)
(vlax-for block (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vlax-for e block
(zero-ent (vlax-vla-object->ename e))
)
)
)
(defun c:zeroz (/ c10 c38 dxf ent i len ss)
(princ "选择需要将Z坐标或标高属性清零的对象 <回车选择所有图元>: ")
(setq ss (ssget))
(if (null ss)
(setq ss (ssget "_X"))
)
(if (null ss)
(progn (princ "\n选择集空")
(quit)
)
)
(setq len (sslength ss)
i 0
c10 0
c38 0
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
;; 块定义内实体归零
(zero-block)
(repeat len
(zero-ent (setq ent (ssname ss i)))
;;; ((wcmatch (cdr (assoc 0 dxf)) "INSERT,POLYLINE")
;;; (setq ent (entnext ent))
;;;
;;; (while (and ent
;;; (setq et (cdr (assoc 0 (setq dxf (entget ent)))))
;;; (= et "ATTDEF")
;;; (/= et "SEQEND")
;;; )
;;; (zero-ent ent)
;;; (setq ent (entnext ent))
;;; )
;;; )
(setq i (1+ i))
)
(vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(command "_.regen")
(princ (strcat "选择的 "
(itoa len)
" 个对象中,\n"
(itoa c10)
" 个非零Z坐标, "
(itoa c38)
" 个标高属性被强制清零."
)
)
(princ)
)

(vl-load-com) 
 
(defun getboundingbox (ename / lb ur) 
  (vla-getboundingbox 
    (vlax-ename->vla-object ename) 
    'lb 
    'ur 
  ) 
  (mapcar 'vlax-safearray->list (list lb ur)) 
) 
;; 
 
 
(defun move-region-to-wcs-plan (ename / obj z) 
  (setq obj (vlax-ename->vla-object ename)) 
  (if (and 
  (= "AcDbRegion" (vla-get-objectname obj)) 
  (/= 0.0 (setq z (caddr (car (getboundingbox ename))))) 
      ) 
    (vla-move obj 
        (vlax-3d-point (list 0 0 z)) 
        (vlax-3d-point (list 0 0 0)) 
    ) 
  ) 
) 
;; (move-region-to-wcs-plan(car(entsel))) 
 
 
;; http://bbs.mjtd.com/thread-93123-1-1.html 
(defun correct210 (ent / obj za) 
  (setq obj (vlax-ename->vla-object ent)) 
  (if (and (vlax-property-available-p obj 'normal t) 
     (not  (equal '(0 0 1) 
           (setq za  (vlax-safearray->list 
          (vlax-variant-value (vla-get-normal obj)) 
        ) 
           ) 
    ) 
     ) 
      ) 
    (vl-catch-all-apply 'vla-put-normal (list obj (vlax-3d-point '(0 0 1)))) 
;;;    (progn 
;;;      (setq za (vlax-safearray->list 
;;;     (vlax-variant-value (vla-get-normal obj)) 
;;;         ) 
;;;      ) 
;;;      (vla-transformby 
;;;  obj 
;;;  (vlax-tmatrix 
;;;    (list 
;;;      (list 1 0 (car za) 0) 
;;;      (list 0 1 (cadr za) 0) 
;;;      (list 0 0 (caddr za) 0) 
;;;      (list 0 0 0 1) 
;;;    ) 
;;;  ) 
;;;      ) 
;;;    ) 
  ) 
) 
;; 
 
(defun zero-group (e) 
  (cond 
    ;; 处理 10-14 段，含 Z 坐标且非零组码，设置Z = 0.0 
    ((and (>= (car e) 10) 
    (<= (car e) 14) 
    (> (length e) 3) 
    (/= 0.0 (nth 3 e)) 
     ) 
     (setq c10 (1+ c10)) 
     (cons (car e) (list (cadr e) (caddr e) 0.0)) 
    ) 
 
    ;; 处理 38 段（标高属性） 
    ((and (= (car e) 38) (/= 0.0 (cdr e))) 
     (setq c38 (1+ c38)) 
     '(38 . 0.0) 
    ) 
 
    ;; 其余组码原样返回 
    (t e) 
  ) 
) 
 
(defun zero-ent  (e / dxf new) 
  ;;(correct210 e) 
 
  (setq dxf (entget e)) 
 
  (if (= (cdr (assoc 0 dxf)) "REGION") 
    (move-region-to-wcs-plan e) 
 
    (progn 
      (setq new (mapcar 'zero-group dxf)) 
      (if (not (equal dxf new)) 
  (entmod new) 
      ) 
    ) 
  ) 
  new 
) 
 
(defun zero-block (/) 
  (vlax-for block (vla-get-blocks 
        (vla-get-activedocument (vlax-get-acad-object)) 
      ) 
    (vlax-for e  block 
      (zero-ent (vlax-vla-object->ename e)) 
    ) 
  ) 
) 
 
 
(defun c:zeroz (/ c10 c38 dxf ent i len ss) 
  (princ "选择需要将Z坐标或标高属性清零的对象 <回车选择所有图元>: ") 
   
  (setq ss (ssget)) 
  (if (null ss) 
    (setq ss (ssget "_X")) 
  ) 
  (if (null ss) 
    (progn (princ "\n选择集空") 
     (quit) 
    ) 
  ) 
 
  (setq  len (sslength ss) 
  i   0 
  c10 0 
  c38 0 
  ) 
 
  (vla-startundomark 
    (vla-get-activedocument (vlax-get-acad-object)) 
  ) 
 
  ;; 块定义内实体归零 
  (zero-block) 
 
  (repeat len 
 
    (zero-ent (setq ent (ssname ss i))) 
 
;;;      ((wcmatch (cdr (assoc 0 dxf)) "INSERT,POLYLINE") 
;;;       (setq ent (entnext ent)) 
;;;       
;;;       (while (and ent 
;;;       (setq et (cdr (assoc 0 (setq dxf (entget ent))))) 
;;;       (= et "ATTDEF") 
;;;       (/= et "SEQEND") 
;;;        ) 
;;;   (zero-ent ent) 
;;;   (setq ent (entnext ent)) 
;;;       ) 
;;;      ) 
    (setq i (1+ i)) 
  ) 
 
 
  (vla-endundomark 
    (vla-get-activedocument (vlax-get-acad-object)) 
  ) 
 
  (command "_.regen") 
 
  (princ (strcat "选择的 " 
     (itoa len) 
     " 个对象中,\n" 
     (itoa c10) 
     " 个非零Z坐标, " 
     (itoa c38) 
     " 个标高属性被强制清零." 
   ) 
  ) 
  (princ) 
)

网友答: 本帖最后由 KO你于 2021-6-12 08:26 编辑

大佬，有些内嵌动态块的属性字没能归零，能加上这个吗
(setvar "cmdecho" 0)
(command "_.UCS" "")
(command "_.move" "_all" "" '(0 0 1e99) "" "_.move" "_p" "" '(0 0 -1e99) "")
(setvar "cmdecho" 1)
(princ)
)end

网友答: 我想知道到 210组码是啥意思看不懂
DXF：拉伸方向的 X 值

APP：三维拉伸方向矢量
这个比如说一个三维圆（10 0 0 0）（40 5）（210 0.46 -0.22 0.86）这个 210组码是啥意思

网友答: 抢座支持!!!

网友答: 强力支持！！

网友答: 支持楼主继续研究

网友答: Z值归零程序，不能按非统一比例缩放，到底什么关系？是什么错误？楼主给大家讲讲吧！

网友答: 这个代码怎么用呢，能存成lsp格式直接用吗

网友答: 期待楼主解决非(210 0 0 1)的Z轴变零。

网友答: 十分感谢，但是这个代码里有好多 defun +**** 字符，一般来说defun后面就是快捷键对吗？（我是外行）

网友答: 研究了一下，貌似是 defun c：后的字符才是快捷键吧

，但我就很好奇，做编程的也画cad吗？你们也画施工图？

网友答: 谢谢，挺实用的程序！

上一篇：论坛里的图库插件，自己稍微改了一下，用着用

下一篇：没有了