在AutoCAD里面,Z坐标归零有很多方法,根据不同的环境做出选择。
法向坐标为-1的情况,只有重新描一遍对象才可以归零,这样图纸才不会出现问题。
在默认法向坐标1的情况下,流行的有两个。
1)选择除块以外的对象,移动对象到Z无穷远,然后移动回来,坐标就归零了,不过有个情况就是,如果对象本来就是无穷远,就不好用了。
2)Z坐标归零加强版。对块面域等都做出Z坐标归零,原理是在AutoCAD里面,所有对象都有属性,代码10~15是表示坐标,多段线标高代码为38,那么对这些Z坐标修改为0,达到Z变0的要求。就是不得修改法向坐标。代码如下:
;;;;;;Z坐标归零;;
(defun c:z0 ( / block c10 c38 e ent i len ss)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
;;包围盒坐标
(defun getboundingbox (ename / lb ur)
(vla-getboundingbox (vlax-ename->vla-object ename) 'lb 'ur)
(mapcar 'vlax-safearray->list (list lb ur))
)
;移动对象面域Z归零
(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)) )
)
)
(defun zero-group (x / x)
(cond;; 处理 10-15 段,含 Z 坐标且非零组码,设置Z = 0.0
((and (>= (car x) 10) (<= (car x) 15) (> (length x) 3) (/= 0.0 (nth 3 x)))
(setq c10 (1+ c10))
(cons (car x) (list (cadr x) (caddr x) 0.0))
)
;; 处理 38 段(标高属性)
((and (= (car x) 38) (/= 0.0 (cdr x)))
(setq c38 (1+ c38))
'(38 . 0.0)
)
;; 其余组码原样返回
(t x)
)
)
(defun zero-ent (e / dxf new)
(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
)
(if (null vlax-dump-object) (vl-load-com) )
(princ "选择需要将Z坐标或标高属性清零的对象 <回车选择所有图元>: ")
(if (null (setq ss (ssget))) (setq ss (ssget "X")) )
(if ss
(progn
(setq len (sslength ss) i 0 c10 0 c38 0)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
;; 块定义内实体归零
(vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for e block
(zero-ent (vlax-vla-object->ename e))
)
)
;;除块以外Z标高归零
(repeat len
(zero-ent (setq ent (ssname ss i)))
(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 "\n选择集为空")
)
(princ)
)
(defun C:tes ( / &ac0 &k1 &kw1 &ob1 mspace);重新描一遍对象;圆,椭圆,弧,直线,多段线
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) )
;(command "UCS" "")
(setq mSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) &n4 0)
(if (setq &kw1 (ssget '((0 . "CIRCLE,ELLIPSE,ARC,LINE,LWPOLYLINE"))));1
(progn;;1
(setq &n5 (rtos (sslength &kw1) 2 0))
(while (setq &k1 (ssname &kw1 0));1
(setq &kw1 (ssdel &k1 &kw1) &ob1 (vlax-ename->vla-object &k1) &ac0 (vla-get-objectname &ob1) &n6 0)
(if (member &ac0 '("AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbLine" "AcDbPolyline")) (setq &n6 (T~20150708~1 &ob1 &ac0 mSpace)) )
(setq &n4 (+ &n4 &n6))
(vla-delete &ob1)
);while;1
(princ (strcat "\n共处理了" &n5 "个曲线," "共删除了长度小于0.05的曲线" (rtos &n4 2 0) "个"))
);progn;1
);if;1
(prin1)
)
;;=============
;重新描一遍对象
;==============
(defun T~20150708~1 (&ob1 &ac0 mSpace / &ac0 &ang1 &ang2 &ang3 &clo &co1 &cx1 &dis1 &dis2 &dis3 &end &n1 &n2 &n3 &ob1 &ob2 &p1 &p2 &p3 &p5 &r1 &ss1 &sta &tc1 aw ew mspace)
(if (< (vlax-curve-getDistAtParam &ob1 (vlax-curve-getEndParam &ob1)) 0.05);1
(setq &n3 1)
(progn;;1
(setq &sta (vlax-curve-getStartPoint &ob1);起点
&sta (list (car &sta) (cadr &sta))
&end (vlax-curve-getEndPoint &ob1);端点
&end (list (car &end) (cadr &end))
&tc1 (vla-get-layer &ob1);图层
&co1 (vla-get-Color &ob1);颜色
&cx1 (vla-get-Linetype &ob1);线型
aw (vlax-curve-isClosed &ob1);闭合
&n3 0
)
(if (member &ac0 '("AcDbArc" "AcDbCircle" "AcDbEllipse"));2
(progn;;2
(setq &p3 (vla-get-Center &ob1) &p1 (Vlax-SafeArray->List (Vlax-Variant-Value &p3)) &p1 (list (car &p1) (cadr &p1)) &p3 (Vlax-3d-Point &p1))
(if (member &ac0 '("AcDbCircle" "AcDbArc")) (setq &R1 (vla-get-radius &ob1)) )
(if (member &ac0 '("AcDbArc" "AcDbEllipse")) (progn (setq &ang1 (vla-get-StartAngle &ob1) &ang2 (vla-get-EndAngle &ob1)) ))
(if (= &ac0 "AcDbCircle") (entmake (list '(0 . "CIRCLE") (cons 8 &tc1) (cons 62 &co1) (cons 6 &cx1) (cons 10 &p1) (cons 40 &R1))) )
(if (= &ac0 "AcDbArc");3-1
(progn;3-1
(setq &dis1 (* (vlax-curve-getDistAtParam &ob1 (vlax-curve-getEndParam &ob1)) 0.5) &p5 (vlax-curve-getPointAtDist &ob1 &dis1) &p5 (list (car &p5) (cadr &p5)))
;(setq &ob2 (vla-addArc mSpace &p3 &R1 &ang1 &ang2))
;(vla-put-layer &ob2 &tc1) (vla-put-Color &ob2 &co1) (vla-put-Linetype &ob2 &cx1)
(setq &ang1 (rem (angle &p1 &sta) (* pi 2)) &ang2 (rem (angle &p1 &end) (* pi 2)))
(entmake (list '(0 . "ARC") (cons 8 &tc1) (cons 62 &co1) (cons 6 &cx1) (cons 10 &p1) (cons 40 &R1) (cons 50 &ang1) (cons 51 &ang2)))
(setq &ob2 (entlast) &ob2 (vlax-ename->vla-object &ob2))
(setq &dis1 (* (vlax-curve-getDistAtParam &ob2 (vlax-curve-getEndParam &ob2)) 0.5) &p2 (vlax-curve-getPointAtDist &ob2 &dis1))
(if (>= (distance &p5 &p2) &R1);3-2
(progn;;3-2
(vla-delete &ob2)
(entmake (list '(0 . "ARC") (cons 8 &tc1) (cons 62 &co1) (cons 6 &cx1) (cons 10 &p1) (cons 40 &R1) (cons 50 &ang2) (cons 51 &ang1)))
);progn;3-2
);if;3-2
);progn;3-1
);if;3-1
(if (= &ac0 "AcDbEllipse");3-3
(progn;;3-3
(setq &p2 (vla-get-MajorAxis &ob1)
&p2 (Vlax-SafeArray->List (Vlax-Variant-Value &p2))
&p2 (list (car &p2) (cadr &p2))
&p2 (Vlax-3d-Point &p2)
&dis3 (vla-get-MinorRadius &ob1)
&dis2 (vla-get-MajorRadius &ob1)
&dis2 (/ &dis3 &dis2)
)
(setq &ob2 (vla-addEllipse mSpace &p3 &p2 &dis2))
(vla-put-StartAngle &ob2 &ang1)
(vla-put-EndAngle &ob2 &ang2)
(vla-put-layer &ob2 &tc1) (vla-put-Color &ob2 &co1) (vla-put-Linetype &ob2 &cx1)
(if (= aw nil) ;3-4
(progn;;3-4
(setq &ang3 (- (* pi 2) &ang2) &ang2 (- (* pi 2) &ang1) &ang1 &ang3)
(setq &p5 (vlax-curve-getStartPoint &ob2))
(if (>= (distance &p5 &sta) 0.01);3-5
(progn;;3-5
(vla-put-StartAngle &ob2 &ang1)
(vla-put-EndAngle &ob2 &ang2)
);progn;3-5
);if;3-5
);progn;3-4
);if;3-4
);progn;3-3
);3-3
);progn;2
);if;2
(if (= &ac0 "AcDbLine") (entmake (list '(0 . "LINE") (cons 8 &tc1) (cons 62 &co1) (cons 6 &cx1) (cons 10 &sta) (cons 11 &end))) )
(if (= &ac0 "AcDbPolyline");4
(progn;;4
(setq &n1 (fix (vlax-curve-getEndParam &ob1)) &ss1 '() &n2 0 &p2 nil)
(if aw (setq &clo '(70 . 1)) (progn (setq &clo '(70 . 0) &n1 (1+ &n1)) ))
(repeat &n1
(setq &p1 (vlax-curve-getPointAtDist &ob1 (vlax-curve-getDistAtParam &ob1 &n2)))
(if (or (= &p2 nil) (and (/= &p2 nil) (> (distance &p2 &p1) 1)))
(progn
(setq &p1 (list (car &p1) (cadr &p1)))
(setq &ss1 (cons (cons 10 &p1) &ss1))
(vla-getwidth &ob1 &n2 'aw 'ew)
(setq &ss1 (cons (cons 40 aw) &ss1) &ss1 (cons (cons 41 ew) &ss1))
(setq aw (vla-getBulge &ob1 &n2) &ss1 (cons (cons 42 aw) &ss1))
)
)
(if (and (/= &p2 nil) (< (distance &p2 &p1) 1))
(progn
(setq &ss1 (cdddr &ss1))
(vla-getwidth &ob1 &n2 'aw 'ew)
(setq &ss1 (cons (cons 40 aw) &ss1) &ss1 (cons (cons 41 ew) &ss1))
(setq aw (vla-getBulge &ob1 &n2) &ss1 (cons (cons 42 aw) &ss1))
)
)
(setq &p2 &p1)
(setq &n2 (1+ &n2))
);repeat
(setq &ss1 (reverse &ss1))
(if (> (length &ss1) 4) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 &tc1) (cons 62 &co1) (cons 6 &cx1) '(100 . "AcDbPolyline") (cons 90 (/ (length &ss1) 4)) &clo ) &ss1)) )
);progn;4
);if;4
);progn;1
);if;1
&n3
);;复制到记事本,以【.lsp】为后缀命名,打开CAD,autolisp加载,命令【TES】,就会把对象重新描一遍
不要在3d视角下画,选择在二维坐标下,例如:x-y轴下画线就行
1、点击工具栏上的(视图)-(三维视图)-(主视)
2、点击工具栏上的(视图)-(着色)-(二维线框)就可以了!