home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / FA / 3DEDIT.LSP next >
Encoding:
Text File  |  1988-10-06  |  4.4 KB  |  146 lines
  1. ;******FA\3DEDIT.LSP******
  2. (if (null sol) (setq sol "off"))
  3. (if (null lbl0) (setq lbl0 0.0))
  4. (if (null lbb0) (setq lbb0 0.0))
  5. (if (null lhh0) (setq lhh0 (cadr (getvar "viewctr"))))
  6. (if (null bhb0) (setq bhb0 (car (getvar "viewctr"))))
  7. (defun e0t0 ( )
  8.     (setq se (getvar "elevation"))
  9.     (setq st (getvar "thickness"))
  10.   (setvar "elevation" 0)
  11.   (setvar "thickness" 0)
  12. )
  13. (defun ests ( )
  14.   (setvar "elevation" se)
  15.   (setvar "thickness" st)
  16. )
  17. ;------------
  18. (defun C:PLP0 ( )
  19.   (e0t0)
  20.   (setq plp0 (getpoint "\n enter point plp0<viewctr>:"))
  21.     (if (null plp0) (setq plp0 (getvar "viewctr")))
  22.   (if (/= (getvar "clayer") "0") (command "layer" "m" "0" ""))
  23.   (if (/= (getvar "cecolor") "1") (command "color" "1"))
  24.   (setq vl (* (getvar "viewsize") 0.5))
  25.   (command "pline" (setq p1 (polar plp0 -1.570796 vl))
  26.     (setq p1 (polar p1 1.570796 (* vl 2))) plp0
  27.     (setq p1 (polar plp0 pi (* 1.267666 vl)))
  28.     (setq p1 (polar p1 0.0 (* vl 2.535333))) "")
  29. )
  30. (defun rplp0 ( )
  31.   (command "osnap" "int")
  32.   (setq ppp (entsel "enter point to pline:"))
  33.   (command "osnap" "")
  34.   (setq plp0 (cadr ppp))
  35.   (setq lhh0 (cadr plp0) bhb0 (car plp0))
  36.   (setq lbb0 (caddr (assoc 10 (entget (entnext (car ppp))))))
  37.   (setq lbl0 (cadr (assoc 10 (entget (entnext
  38.     (entnext (entnext (entnext (entnext)))))))))
  39. )
  40. ;----------
  41. (defun C:3DLS ( )
  42.   (setq ppp (ssget))
  43.   (if (/= (getvar "clayer") "3d") (command "layer" "m" "3d" ""))
  44.   (setq wxr (getstring "LL/BB/HH <BB>:"))
  45.     (if (= wxr "") (setq wxr "bb"))
  46.     (if (= wxr "ll") (setq 3dpls 3dplsl))
  47.     (if (= wxr "bb") (setq 3dpls 3dplsb))
  48.     (if (= wxr "hh") (setq 3dpls 3dplsh))
  49.   (setq dd (getreal "enter dd:"))
  50.   (setq wcy 0 n (sslength ppp))
  51.     (while (< wcy n)
  52.       (setq s (cdr (assoc 0 (setq e (entget 
  53.           (setq p (ssname ppp wcy)))))))
  54.       (command "color" (cdr (assoc 62 e)))
  55.         (if (= "3DLINE" s) (3dlls))
  56.         (if (= "3DFACE" s) (3dfls))
  57.       (setq wcy (1+ wcy))
  58.       (prompt "Working...")
  59.     )
  60. )
  61. (defun 3dplsl (3dp)
  62.   (setq 3dpb (list (+ (car 3dp) dd) (cadr 3dp) (caddr 3dp)))
  63. )
  64. (defun 3dplsb (3dp)
  65.   (setq 3dpb (list (car 3dp) (+ (cadr 3dp) dd) (caddr 3dp)))
  66. )
  67. (defun 3dplsh (3dp)
  68.   (setq 3dpb (list (car 3dp) (cadr 3dp) (+ (caddr 3dp) dd)))
  69. )
  70. (defun 3dlls ( )
  71.   (setq 3dp1 (cdr (assoc 10 e)))
  72.   (setq 3dp2 (cdr (assoc 11 e)))
  73.   (setq 3dp11 (3dpls 3dp1))
  74.   (setq 3dp22 (3dpls 3dp2))
  75.   (entdel p)
  76.   (command "3dface" 3dp1 3dp2 3dp22 3dp11 "")
  77. )
  78. (defun 3dfls ( )
  79.   (setq 3dp1 (cdr (assoc 10 e)))
  80.   (setq 3dp2 (cdr (assoc 11 e)))
  81.   (setq 3dp3 (cdr (assoc 12 e)))
  82.   (setq 3dp4 (cdr (assoc 13 e)))
  83.   (setq 3dp11 (3dpls 3dp1))
  84.   (setq 3dp22 (3dpls 3dp2))
  85.   (setq 3dp33 (3dpls 3dp3))
  86.   (setq 3dp44 (3dpls 3dp4))
  87.   (command "3dface" 3dp1 3dp11 3dp22 3dp2 3dp3 3dp33 3dp44 3dp4
  88.     3dp1 3dp11 "")
  89.   (command "3dface" 3dp11 3dp22 3dp33 3dp44 "")
  90. )
  91. ;----------
  92. (defun entbp ( )
  93.   (setq bp (getpoint "Base point:"))
  94.   (setq bpx (car bp) bpy (cadr bp))
  95.   (if (< bpy lhh0)
  96.     (progn
  97.       (setq bpz (getreal "enter bpz<0.0>:"))
  98.       (if (null bpz) (setq bpz 0.0)))
  99.     (progn
  100.       (setq bpz (- bpy lhh0))
  101.       (if (> bpx bhb0) (setq bpx (- bpx bhb0))))
  102.   )
  103. )
  104. (defun C:ROTATE3 ( )
  105.   (e0t0)
  106.   (if (/= (getvar "clayer") "lm") (command "layer" "m" "lm" ""))
  107.   (setq ppp (ssget))
  108.   (setq wxr (getstring "zz/xx/yy <zz>:"))
  109.   (if (or (= wxr "zz") (= wxr ""))
  110.     (progn (setq bp (getpoint "Base point:"))
  111.     (setq ra (getangle "Rotation angle:" bp))
  112.     (command "rotate" ppp "" bp ra)))
  113.   (if (= wxr "xx") (progn (setq 3dprot 3dprotx) (entbp)
  114.     (setq ah (getangle "Rotate angle:" bp))))
  115.   (if (= wxr "yy") (setq 3dprot 3dproty))
  116.   (setq wcy 0 n (sslength ppp))
  117.     (while (< wcy n)
  118.       (setq s (cdr (assoc 0 (setq e (entget (ssname ppp wcy))))))
  119.       (command "color" (cdr (assoc 62 e)))
  120.         (if (= "LINE" s) (lto2d))
  121.         (if (= "POINT" s) (pto2d))
  122.         (if (= "3DLINE" s) (3dlrot))
  123.         (if (= "3DFACE" s) (3dfto2d))
  124.       (setq wcy (1+ wcy))
  125.       (prompt "Working...")
  126.     )
  127.   (ests)
  128. )
  129. (defun 3dlrot ( )
  130.   (setq 3dp1 (assoc 10 e))
  131.   (setq 3dp2 (assoc 11 e))
  132.   (setq 3dp11 (3dprot 3dp1))
  133.   (setq 3dp22 (3dprot 3dp2))
  134.   (command "3dline" 3dp11 3dp22 "")
  135. )
  136. (defun 3dprotx (3dp)
  137.   (setq 3dp (cdr 3dp))
  138.   (setq 3dpx (car 3dp) 3dpy (cadr 3dp) 3dpz (caddr 3dp))
  139.   (setq 3dp (list 3dpx (* (- 3dpy bpy) (cos ah))
  140.       (* (- 3dpz bpz) (sin ah))))
  141. )
  142. (defun C:CLEAN2 ( )
  143.   (setq atomlist (member 'C:CLEAN2 atomlist))
  144.   'DONE2
  145. )
  146.