Prikazi cijelu temu 04.01.2011 13:06
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Masinska pozicija
Masinska pozicija
PreuzmiIzvorni kôd (Lisp):
  1. (command "Layer" "s" "0" "")
  2. (setq V (getreal "Mjerilo 1:X: "))
  3. (setq B (/ 0.5 V))
  4. (setq txt "a")
  5. (while (/= txt "")
  6.   (setq txt (getstring "Poz: "))
  7.   (if (/= txt "")
  8.     (progn
  9.       (setq pt1 (getpoint "Po
  10. etak linije: "))
  11.       (setq pt2 (getpoint pt1 "Kraj linije: "))
  12.       (setq l (* (strlen txt) (/ 4 V)))
  13.       (if (or (> (car pt1) (car pt2)))
  14.         (progn
  15.           (setq pt3 (list (- (car pt2) l) (cadr pt2)))
  16.           (setq
  17.             pt4 (list (- (car pt2) (/ l 2)) (+ (cadr pt2) (/ 1.5 V)))
  18.           )
  19.           (setq ang (angle pt1 pt2))
  20.           (setq pt5 (polar pt1 ang 0.5))
  21.         )
  22.         (progn
  23.           (setq pt3 (list (+ (car pt2) l) (cadr pt2)))
  24.           (setq
  25.             pt4 (list (+ (car pt2) (/ l 2)) (+ (cadr pt2) (/ 1.5 V)))
  26.           )
  27.           (setq ang (angle pt1 pt2))
  28.           (setq pt5 (polar pt1 ang 0.5))
  29.         )
  30.       )
  31.     )
  32.   )
  33.   (command "Style" "arial" "Arial" "0" "1" "0" "N" "N")
  34.   (command "PLINE" pt1 "W" B "" pt5 "w" 0 "" pt2 "w" B "" pt3 "")
  35.   (command "TEXT" "C" pt4 (/ 4 V) 0 txt)
  36.   (command "DONUT" 0 B pt1 "")
  37.   (setvar "PLINEWID" 0)
  38.   (command "Style" "STANDARD" "" "" "" "" "" "" "N")
  39. )                                       ;progn
  40. );if
  41. );while

Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.