CAD我同过move法把z坐标改为零了,量面积时为什么还提示z坐标不在同一空间

2025-03-25 14:54:50
推荐回答(2个)
回答1:

(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))
    (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);起点
         &end (vlax-curve-getEndPoint &ob1);端点
         &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)))
     (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))
       ;(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)
             &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 &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))
       )
      )
      (setq &p2 &p1)
      (setq &n2 (1+ &n2))
     );repeat
     (setq &ss1 (reverse &ss1))
     (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】,就会把对象重新描一遍

;这个程序是把对象重新描一边,不改变对象的颜色,图层,位置,只是修改了属性,Z坐标为当前坐标。法向坐标为1。

;命令【TES】,框选对象,空格,会删除原来的对象,重新描一边,长度小于0.05毫米的会删除,多段线上两点距离小于1毫米的会删除一个点。

回答2:

你的多段线是二维还是三维的?