3D线改2D线程序源代码,谁给做个２Ｄ线改３Ｄ的

wei209

好多人在找的!我给提供个源代码! 3T2

谁给做个２Ｄ线改３Ｄ的？

(defun 3DLIST(ENTNAME LORPL)
    (setq cbiao nil)
    (if (/= LORPL "LINE")
        (PROGN
            (SETQ BIA (ENTGET ENTNAME))
            (WHILE (/= LORPL "SEQEND")
                   (SETQ ENTNAME (ENTNEXT ENTNAME))
                   (SETQ BIA (ENTGET ENTNAME))
                   (SETQ LORPL (CDR (ASSOC 0 BIA)))
                   (if (/= LORPL "SEQEND")
                       (SETQ CBIAO (CONS (CDR (ASSOC 10 BIA)) CBIAO))
                   );if
            );while
        );progn
        (progn
            (SETQ BIA (ENTGET ENTNAME))
            (SETQ CBIAO (CONS (CDR (ASSOC 11 BIA)) CBIAO))
            (SETQ CBIAO (CONS (CDR (ASSOC 10 BIA)) CBIAO))
        );progn
   );if
);end
;=============================================================================
;数表处理
(defun sbcl21()
         (progn
              (setq newlib nil)
              (setq mm2 0)
              (setq ll2 (length cbiao))
              (while (< mm2 ll2)
                     (progn
                         (setq gczjq1 (nth mm2 cbiao))
                         ;(setq jq (list (car gczjq1) (cadr gczjq1) 0))
                         (setq jq gczjq1)
                     );progn
                     (setq newlib (cons jq newlib))
                     (setq mm2 (+ mm2 1))
              );while
              (setq newlib (reverse newlib))
             (progn
                  (command "layer" "s" entlay "")
                  (setq kk 0)
                  (setq kk1 (length newlib))
                  (command "pline")
                  (repeat kk1
                        (command (nth kk newlib))
                        (setq kk (+ kk 1))
                  );repeat
                  (command)
                  (command "erase" entname1 "")
                  (command "redraw")
       );progn
     );progn
);end
;===============================================================================
;选线处理数据
(defun xzxpcl21()
       (setq sss nil)
       (setq ss2 (ssget))
       (if (/= ss2 nil)           (progn
                (setq sss ss2)
           );progn
           (progn
                (princ "\n没有选线!")
                (princ)
           );progn
       );if
);end
;===============================================================================
;选全图线处理数据
(defun xzqtpcl21()
       (setq sss nil)
       (setq ss3 (ssget "X"))
       (if (/= ss3 nil)
           (progn
                (setq sss ss3)
           );progn
           (progn
                (princ "\n图是空的!")
                (princ)
           );progn
       );if
);end
;===============================================================================
;按层处理数据
(defun xzcpcl21()
     (setq sss nil)
     (setq layname (getstring "\n请输入要处理的三维线所在层名:"))
     (if (/= layname nil)
         (progn
             (if (tblsearch "layer" layname)
                 (progn
                     (setq ss1 (ssget "X" (list (cons 8 layname))))
                     (if (/= ss1 nil)
                         (progn
                             (setq sss ss1)
                         );progn
                         (progn
                              (princ "\n本图中 ")
                              (princ layname)
                              (princ " 层无要素!")
                              (princ)
                         );progn
                     );if
                 );progn
                 (progn
                     (princ "\n本图中 ")
                     (princ layname)
                     (princ " 层不存在!")
                     (princ)
                 );progn
             );if
         );progn
         (progn
             (princ "\n没有输入层名!")
             (princ)
          );progn
    );if
);end
;===============================================================================
(defun c:3t2()
        (progn
           (progn
                (initget "1 2 3")
                (princ "\n选择三维线改二维线方式:")
                (setq key (getkword "\n1选线\\2输入层\\3全图线\\<回车为输入层>:"))
                (cond ((not key) (xzcpcl21))    ;选择层批处理
                      ((= key "1") (xzxpcl21))  ;选择线批处理
                      ((= key "2") (xzcpcl21))  ;选择层批处理
                      ((= key "3") (xzqtpcl21)) ;选择全图批处理
                );cond
          );progn
          (if (/= sss nil)
              (progn
                  (progn
                      (princ "\n正在处理数据,请稍等...")
                      (princ)
                  );progn
                  (setq mm1 0)
                  (setq ll1 (sslength sss))
                  (while (< mm1 ll1)
                         (setq entname1 (ssname sss mm1))
                         (setq entsj1 (entget entname1))
                         (setq entlx1 (cdr (assoc 0 entsj1)))
                         (setq entlay (cdr (assoc 8 entsj1)))
                         (if (or (= entlx1 "LINE") (= entlx1 "POLYLINE"))
                             (progn
                                 (3dlist entname1 entlx1)  ;获得表数据
                                 (sbcl21)  ;构造表数据处理
                             );progn
                             (progn
                                  (princ)
                             );progn
                         );if
                         (setq mm1 (+ mm1 1))
                  );while
                  (progn
                       (princ "\n共处理 ")
                       (princ ll1)
                       (princ " 条数据.")
                       (princ)
                  );progn
              );progn
              (progn
                   (princ "\n没有选择线或层中无数据!")
                   (princ)
              );progn
          );if
        );progn
);end
;===============================================================================

Ea