[转贴]：3D多义线编辑

lsjjm

3D多义线编辑:
;*-----------------------------------------------------------------------
;* APPLICATION: 3DPEDIT
;* By GLENN WILSON
;*    74730,2726
;*    CENTRE DE TECHNOLOGIE NORANDA
;*    MONTREAL P.Q.
;*-----------------------------------------------------------------------
;* FILE:3DPEDIT.LSP
;* FUNCTIONS: revline,nextvert,mkplist,mkpline,markpt,sublist,3djoin
;*            delents, bits
;* C:3DPEDIT
;*-----------------------------------------------------------------------
;* GLOBAL VARS
;    #plist     ==> vertex list
;    #count     ==> counter (current vertex)
;    #plong     ==> length of vertex list
;    #code70    ==> polyline 70 code
;    #del_list  ==> list of entities to erase
;-----------------------------------------------------------------------
; FUNCTION: revline
; DESCRIPTION: function to reverse a polyline list
; CALLS: NOTHING
; RETURNS: nothing but reverses #plist
;-----------------------------------------------------------------------
(defun revline ()
  (setq #plist (reverse #plist)
        #count 0
  );* END SETQ
  (redraw)
  (markpt (nth #count #plist))
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: nextver
; DESCRIPTION: function to place a cross on the next vert
; CALLS: NOTHING
; RETURNS: sfa but increments #count
;-----------------------------------------------------------------------
(defun nextvert ()
  (markpt (nth #count #plist))
  (setq #count (if (eq #count #plong) 0 (1+ #count)))
  (markpt (nth #count #plist))
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: mkplist
; DESCRIPTION: function to make a list from a pline given the polyline
;              entity
; CALLS: NOTHING
; RETURNS: the list of the pline
;-----------------------------------------------------------------------
(defun mkplist (polyline / vert vertg list_of_verts)
    (setq vert (entnext polyline))
    (setq vertg (entget vert))
      (while (/= (cdr (assoc 0 vertg)) "SEQEND")
        (setq list_of_verts (cons (cdr (assoc 10 vertg)) list_of_verts))
          (setq vert (entnext vert))
          (setq vertg (entget vert))
      );* END WHILE
    (setq list_of_verts (reverse list_of_verts))
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: mkpline
; DESCRIPTION: function to create the new pline
;              
; CALLS: NOTHING
; RETURNS: nothing but draws the new 3dpoly
;-----------------------------------------------------------------------
(defun mkpline (pline_layer pline_color / counter p-length new_pline)
  (command "layer" "s" pline_layer "")
    (setq p-length (1- (length #plist)))
    (setq counter 0)
      (command "3DPOLY")
         (while (<= counter p-length)
            (command (nth counter #plist))
            (setq counter (1+ counter))
         );* END WHILE
      (if (bits 1 #CODE70) (command "C")
                           (command "")
      );* END IF
         (if pline_color
          (progn
           (setq new_pline (entget (entlast)))
           (setq new_pline (subst (con 62 pline_color)
                                  (assoc 62 new_pline)
                                  new_pline
                           );* END SUBST
           );* END SETQ
            (entmod new_pline)
          );* END PROGN
         );* END IF
);* END DEFUN     
;-----------------------------------------------------------------------
; FUNCTION: MARKPT
; DESCRIPTION: Function to draw a special tick at a point location
; CALLS: NOTHING
; RETURNS: NOTHING
;-----------------------------------------------------------------------
(defun markpt (pt / hi)
  (setq hi (/ (getvar "VIEWSIZE") 40.0))
  (setq pt (trans pt 0 1))
  (grdraw (polar pt (* pi 0.25) (- hi)) (polar pt (* pi 0.25) hi) -1)
  (grdraw (polar pt (* pi 0.75) (- hi)) (polar pt (* pi 0.75) hi) -1)
);defun MARKPT
;-----------------------------------------------------------------------
; FUNCTION: sublist
; DESCRIPTION: function to change the starting order of a list
; CALLS: NOTHING
; RETURNS: sfa but modifies #plist and #count
;-----------------------------------------------------------------------
(defun sublist (/ sub subbylong)
(markpt (nth #count #plist))
  (setq subbylong (1- (length #plist)))
       (repeat subbylong
         (setq sub (cons (nth #count #plist) sub))
         (setq #count (if (eq #count subbylong) 0 (1+ #count)))
       );* END REPEAT
    (setq sub (cons (nth #count #plist) sub))
    (setq #plist (reverse sub))
    (setq #count 0)
  (markpt (nth #count #plist))
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: 3djoin
; DESCRIPTION: function to join 2 3dpoly's
; CALLS: NOTHING
; RETURNS:
;-----------------------------------------------------------------------
(defun 3djoin (/ line_2_join join_list)
  (setq line_2_join (car (entsel "\nSelect 3Dpoly: ")))
   (if line_2_join
    (progn
     (if (bits 8 (cdr (assoc 70 (entget line_2_join))))
      (progn
        (setq join_list (mkplist line_2_join))
          (grdraw (last #plist) (car join_list) -1)
        (setq #plist (append #plist join_list))
        (setq #plong (1- (length #plist)))
        (setq #del_list (cons line_2_join #del_list))
      );* END PROGN
      (princ "\nTHIS IS NOT A 3D POLYLINE")
     );* END IF
   );* END PROGN
  (princ "\nNO OBJECT SELECTED")
);* END IF
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: delents
; DESCRIPTION: function to delete a list of entities
; CALLS: NOTHING
; RETURNS:
;-----------------------------------------------------------------------
(defun delents (ents_2_wipe_out / dead_ent)
   (setq dead_ent (1- (length ents_2_wipe_out)))
     (while (>= dead_ent 0)
       (entdel (nth dead_ent ents_2_wipe_out))
       (setq dead_ent (1- dead_ent))
     );* END WHILE
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: bits
; DESCRIPTION: return T if bit1 is present in the int fullbit
;              fullbit can be nil
; CALLS: NOTHING
; RETURNS: the bit or nill
;-----------------------------------------------------------------------
(defun bits (bit1 fullbit)
(if (not fullbit) (setq fullbit 0))
  (setq fullbit (/ fullbit bit1))
    (if (zerop (rem fullbit 2)) nil bit1)
);* END DEFUN
;-----------------------------------------------------------------------
; FUNCTION: 3dpedit command
; DESCRIPTION: command to edit 3d polylines
; CALLS: NOTHING
; RETURNS:
;-----------------------------------------------------------------------
(defun c:3dpedit (/ answ p-line entlayer entcolor cl)
(setvar "cmdecho" 0)
(setvar "highlight" 0)
(setvar "blipmode" 0)
(setq #plist nil)
(setq #count nil)
(setq #del_list nil)
  (setq p-line (car (entsel "\nSelect polyline: ")))
   (if p-line
    (progn
     (if (bits 8 (cdr (assoc 70 (entget p-line))))
      (progn
       (setq #plist (mkplist p-line)
             #plong (1- (length #plist))
             #count 0
             cl (getvar "clayer")
             entlayer (cdr (assoc 8 (entget p-line)))
             entcolor (cdr (assoc 62 (entget p-line)))
             #CODE70 (cdr (assoc 70 (entget p-line)))
       );* END SETQ
        ;*// MARK THE FIRST POINT IN THE LIST //*
        (markpt (nth #count #plist))
   (while (and (/= answ "Quit") (/= answ "Go"))
   (initget "Start Reverse Next Quit Go Join")                              
   (setq answ (getkword                                         
              (strcat "\nStart/Reverse/Join/Go/Quit/<Next>: ")     
              );* END GETKWORD
   );* END SETQ                                                
     (cond ((eq answ "Reverse") (revline));* END FIRST COND   
           ((eq answ "Start")   (sublist));* END OF 2ND COND   
            ((eq answ "Go")      (mkpline entlayer entcolor));* END 3RD COND
           ((eq answ "Quit")    (setq answ "Quit"));*  END 4TH COND
           ((eq answ "Join")    (3djoin));* END OF 5TH COND
           (T                   (nextvert));* END OF 6TH COND
     ); END OF COND
  );* END WHILE
      (entdel p-line)
       (if #del_list (delents #del_list))
      (command "layer" "s" cl "")
      (redraw)
      (setq #plist nil)
      (setq #count nil)
      (setq #del_list nil)
      );* END PROGN
      (princ "\nTHIS IS NOT A 3D POLYLINE")
     );* END IF
  );* END PROGN
  (princ "\nNO OBJECT SELECTED")
);* END IF
   (setvar "blipmode" 1)
   (setvar "highlight" 1)
(princ)
);* END DEFUN

陌生人

好长,那个j用起来有点不顺.

xue-78

好长，有点眼花了

Strewberry

很长啊,不太方便