home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p030 / 2.ddi / CHFACE.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-08-04  |  4.4 KB  |  156 lines
  1. ; **********************************************************************   
  2. ;                            CHFACE.LSP
  3. ;
  4. ; By Jan S. Yoder                                 April 22, 1988
  5. ;
  6. ; A routine to change the end point locations of 3dfaces by pointing.
  7. ;
  8. ; Undo backs up one face at a time, regardless of the number processed.
  9. ;
  10. ; Version 0.3
  11. ;
  12. ; **********************************************************************   
  13.  
  14. ; Internal error handler
  15.  
  16. (defun myerr (s)                     ; If an error (such as CTRL-C) occurs
  17.                                      ; while this command is active...
  18.    (if (/= s "Function cancelled")
  19.        (princ (strcat "\nError: " s))
  20.    )
  21.    (redraw ent 1)
  22.    (command "undo" "e")
  23.    (setvar "osmode" osm)             ; restore old OSNAP value
  24.    (setvar "blipmode" obm)           ; restore old BLIPMODE value
  25.    (setvar "cmdecho" ocmd)           ; restore old CMDECHO value
  26.    (setq *error* olderr)             ; restore old *error* handler
  27.    (princ)
  28. )
  29.  
  30. ; Move the vertex
  31.  
  32. (defun mvvtx (v opt)
  33.   (initget 16)
  34.   (setq npt (getpoint opt "\nNew location: ") )
  35.   (if (= (type npt) 'LIST) 
  36.    (progn
  37.     (setq entl (subst (cons v (trans npt 1 0)) (assoc v entl) entl) ) 
  38.     (entmod entl) ) ) 
  39. )
  40.  
  41. ; Allow selection of 3dfaces to redraw while editing
  42.  
  43. (defun disply (/ ss n1 t1)
  44.   (cond (ss (princ "\nRedrawing entities...")
  45.             (repeat (sslength ss)
  46.               (ssadd (setq t1 (ssname ss (setq n1 (1+ n1)))) faclst)
  47.             )
  48.             (princ "done.")
  49.         T)                           ; return T
  50.   )
  51. )
  52.  
  53. ; Find the vertex by pointing
  54.  
  55. (defun findpt ()
  56.   (foreach n '(10 11 12 13)
  57.     (if (equal ans (cdr(assoc n entl)))
  58.       (setq savn n)
  59.     )
  60.   )
  61.   savn
  62. )
  63.  
  64. ; Main program
  65.  
  66. (defun C:CHFACE (/ splfo osm rg ent oflags entvtx1 entvtx2
  67.                    entvtx3 entvtx4 ans flags tst test)
  68.  
  69.  (setq olderr   *error*
  70.          *error*  myerr)
  71.  (setq ocmd (getvar "cmdecho"))      ; save old CMDECHO value
  72.  (setvar "cmdecho" 0)                ; set CMDECHO off
  73.  (setq osm (getvar "osmode"))        ; save old OSNAP value
  74.  (setq obm (getvar "blipmode"))      ; save old BLIPMODE value
  75.  (setvar "blipmode" 0)               ; set BLIPMODE to off
  76.  
  77.  (setq cont "Yes")
  78.  
  79. ; Get all the faces in the database
  80.   
  81.  (setq fcs (ssget "x" '((0 . "3DFACE"))))
  82.  
  83.   (setq test T ent nil xit T)
  84.   (while test
  85.    (setq ent (car(entsel "\nSelect the entity to change: ")))
  86.    (if (equal ent nil)
  87.      (princ "\nNo entity selected.  Please try again. ")
  88.      (progn
  89.       (setq savent ent
  90.             entl (entget ent))
  91.       (if (equal (cdr(assoc 0 entl)) "3DFACE")
  92.        (setq test nil)
  93.        (princ "\nEntity selected is not a 3Dface. ")
  94.       )
  95.      )
  96.    )
  97.   )
  98.  
  99.   (setvar "osmode" 1)                ; set osmode to endpoint
  100.   (while xit
  101.     (command "undo" "group")
  102.     (disply)
  103.     (redraw ent 3)
  104.     (initget "1 2 3 4 Undo Display")
  105.     (setq ans (getpoint "\n1/2/3/4/Undo/Display/<Select vertex>: "))
  106.     (cond
  107.       ((= ans "1")
  108.         (setq entvtx (trans (cdr(assoc 10 entl)) 0 1))
  109.         (mvvtx 10 entvtx)
  110.       )
  111.       ((= ans "2")
  112.         (setq entvtx (trans (cdr(assoc 11 entl)) 0 1))
  113.         (mvvtx 11 entvtx)
  114.       )
  115.       ((= ans "3")
  116.         (setq entvtx (trans (cdr(assoc 12 entl)) 0 1))
  117.         (mvvtx 12 entvtx)
  118.       )
  119.       ((= ans "4")
  120.         (setq entvtx (trans (cdr(assoc 13 entl)) 0 1))
  121.         (mvvtx 13 entvtx)
  122.       )
  123.       ((= ans "Undo")
  124.         (command "undo" "e")
  125.         (command "undo" "3")
  126.         (setq ent savent
  127.               entl (entget ent))     ; restore saved entity
  128.       )
  129.       ((= ans "Display")
  130.         (initget "All Select")
  131.         (setq ss (if (eq (setq ans (getkword "\nSelect/<All>: ")) "Select")
  132.                      (ssget)
  133.                  )
  134.               n1 -1
  135.         )
  136.         (if (= ans "Select") (disply) (redraw))
  137.       )
  138.       ((= (type ans) 'LIST)
  139.         (setq n (findpt)
  140.               entvtx (trans (cdr(assoc n entl)) 0 1))
  141.         (mvvtx n entvtx)
  142.       )
  143.       ((or (= ans "") (= ans nil))
  144.         (setq xit nil)
  145.         (redraw ent 1)
  146.         (command "undo" "e")
  147.         (setvar "osmode" osm)        ; restore old OSNAP value
  148.         (setvar "blipmode" obm)      ; restore old BLIPMODE value
  149.         (setvar "cmdecho" ocmd)      ; restore old CMDECHO value
  150.         (setq *error* olderr)        ; restore old *error* handler
  151.         (princ)                       
  152.       )
  153.     )
  154.   )
  155. )
  156.