强力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 eblock
(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)
)
)
(setqlen (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吗？ 你们也画施工图？ 谢谢，挺实用的程序！
页:
[1]
2