home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / TY / DDIM2.LSP < prev    next >
Encoding:
Text File  |  1990-01-15  |  2.6 KB  |  113 lines
  1. (DEFUN DI0()
  2.      (SETQ P1 (GETPOINT "\nFrom point:"))
  3.      (COMMAND "OSNAP" "PER")
  4.      (SETQ P2 (GETPOINT P1 "\nSelect object:<Per>"))
  5.      (COMMAND "OSNAP" "NONE")
  6.      (SETQ S (SSGET "C" P1 P2))
  7. )
  8. ;   ********************
  9. (DEFUN DI1()
  10.      (SETQ KK (SSLENGTH S))
  11.      (SETQ K 0 S1 NIL)
  12.      (WHILE (< K KK)
  13.      (SETQ S2 (SSNAME S K))
  14.      (SETQ S2 (ENTGET S2))
  15.      (SETQ S3 (CDR (ASSOC 0 S2)))
  16.      (IF (= S3 "LINE") (SETQ S1 (CONS S2 S1)))
  17.      (SETQ K (1+ K))
  18.      )
  19. )
  20. ;    ********************
  21. (DEFUN DI2()
  22.      (SETQ KK (LENGTH S1))
  23.      (SETQ K 0 S2 NIL)
  24.      (SETQ A1 (ABS (ANGLE P1 P2)))
  25.      (SETQ A4 (* 0.5 PI))
  26.      (SETQ A5 (* 1.5 PI))
  27.      (WHILE (< K KK)
  28.      (SETQ S3 (NTH K S1))
  29.      (SETQ S4 (CDR (ASSOC 10 S3)))
  30.      (SETQ S5 (CDR (ASSOC 11 S3)))
  31.      (SETQ A2 (ABS (ANGLE S4 S5)))
  32.      (SETQ A3 (ABS (- A1 A2)))
  33.      (SETQ A6 (ABS (- A3 A4)))
  34.      (SETQ A7 (ABS (- A3 A5)))
  35.      (IF (OR (< A6 0.00001) (< A7 0.00001)) (PROGN
  36.      (SETQ S (INTERS P1 P2 S4 S5))
  37.      (SETQ S2 (CONS S S2))))
  38.      (SETQ K (1+ K))
  39.      )
  40. )
  41. ;    **********************
  42. (DEFUN DI3()
  43.      (SETQ KK (LENGTH S2))
  44.      (SETQ K 0 S NIL S3 NIL)
  45.      (WHILE (< K KK)
  46.      (SETQ P (NTH K S2))
  47.      (SETQ S1 (DISTANCE P2 P))
  48.      (SETQ P (CONS S1 P))
  49.      (SETQ S (CONS P S))
  50.      (SETQ S3 (CONS S1 S3))
  51.      (SETQ K (1+ K))
  52.      )
  53. )
  54. ;   ***********************
  55. (DEFUN DI4()
  56.      (SETQ K 0 S1 NIL)
  57.      (WHILE (< K KK)
  58.      (SETQ S2 (CAR S3))
  59.      (SETQ K1 1)
  60.      (WHILE (< K1 KK)
  61.      (SETQ S4 (NTH K1 S3))
  62.      (IF (< S2 S4) (SETQ S2 S4))
  63.      (SETQ K1 (1+ K1))
  64.      )
  65.      (SETQ S1 (CONS S2 S1))
  66.      (SETQ S3 (SUBST 0.0 S2 S3))
  67.      (SETQ K (1+ K))
  68.      )
  69. )
  70. ;    *******************************
  71. (DEFUN DI5()
  72.      (SETVAR "DIMEXO" 1)
  73.      (SETVAR "DIMEXE" 1)
  74.      (SETQ P3 (CADR S1))
  75.      (DI10 P3)
  76.      (SETQ P4 (CDR (ASSOC P3 S)))
  77.      (COMMAND "DIM" "ALI" P2 P4 P2 X)
  78.      (SETQ K 2)
  79.      (WHILE (< K KK)
  80.      (SETQ P4 (NTH K S1))
  81.      (SETQ S2 (- P4 P3))
  82.      (DI10 S2)
  83.      (SETQ P5 (CDR (ASSOC P4 S)))
  84.      (SETQ P3 P4)
  85.      (COMMAND "CON" P5 X)
  86.      (SETQ K (1+ K))
  87.      )
  88.      (COMMAND "EXIT")
  89. )
  90. ;    ******************************8
  91. (DEFUN DI10(X1)
  92.      (SETQ X1 (+ X1 0.0001))
  93.      (SETQ X (FIX X1))
  94.      (SETQ X2 (- X1 X))
  95.      (SETQ X2 (* 100 X2))
  96.      (SETQ X2 (FIX X2))
  97.      (SETQ X (ITOA X))
  98.      (IF (/= X2 0) (PROGN
  99.      (SETQ X2 (ITOA X2))
  100.      (SETQ X (STRCAT X "." X2))))
  101. )
  102. ;    **************************8
  103. (DEFUN C:DIMP2()
  104.      (COMMAND "LAYER" "MAKE" "D1" "C" "1" "D1" "")
  105.      (DI0)
  106.      (DI1)
  107.      (DI2)
  108.      (DI3)
  109.      (DI4)
  110.      (DI5)
  111.      (COMMAND "LAYER" "SET" "0" "")
  112. )
  113.