[Александр]

Здравствуйте !
Подскажите, плз.
Как построить плоскую полилинию по мат уравнению или формуле ?
Как построить плоскую полилинию по точкам, заданным в виде таблицы ?
Заранее благодарен , Sincerely Yours , Alex

[plaz]

Учите VBA!!!

[kos]

или LISP...

[Alex_k]

Гдето была такая лиспина.
Если найду то вышлю.

[Alex_k]

Вот лиспина из 12 АвтоКАДа которая читает координаты из файла и строит по ним полилинию:

Код:

[Выделить все]

(if (null fl$$) (setq fl$$ '((masht (1 1)))))
(if (null str$$) (setq str$$ '(nil nil nil nil)))
(vmon) (setq num$$ 0)

(defun fun (nf) ((eval nf)))

(defun helpsle nil (princ (strcat 
"\n\nСенников В.Ю.  УГК ЯМЗ, Ярославль 4 февpаля 1993 г.\n"
"Введите либо:\n" 
" а> X,Y <или X Y> - координаты точки начала системы координат;\n"
" б> Укажите координаты мышью;\n"
" в> <X> или <Y> для перевода начала кривой в начало системы\n" 
"     координат и обратно по осям соответственно x и y;\n"
" г> <м> или <m> или <M> для ввода масштаба.\n"
"       Будет выдан запрос <Введите масштаб:> на который надо ввести\n" 
"     численные значения масштаба по осям x и y через пробел или\n" 
"     запятую;\n"
" д> Режим объектной привязки <распространяется только в текущем\n"
"    вызове программы>.\n"))
nil
) 

(defun helpins (s1 s2) 
 (princ (strcat 
"\nСенников В.Ю.  УГК ЯМЗ, Ярославль 4 февpаля 1993 г.\n"
"Введите либо:\n"
"  а> Строку статуса из 4-х чисел через пробелы:\n"
"     1-е  номер столбца " s1 " в файле или отрицательное - приращение " s1 ";\n"
"     2-е  номер столбца " s2 " в файле или\n" 
"                  отрицательное - приращение " s2 ";\n"
"     3-е  номер начальной строки считывания;\n"
"     4-е  шаг считывания строк;\n"
"  б> RETURN для сохранения статуса по умолчанию;\n"
"  в> Строку из менее 4-х чисел, остальные по умолчанию."))
nil
)
  
(defun modes (spvar / mlst)
  (foreach n spvar (setq mlst (cons (list n (getvar n)) mlst)))
)

(defun moder (mlst)
 (foreach n mlst (setvar (car n) (cadr n)))
)

(defun t12 (a b)
 (while 
   (cond 
     ((and (numberp a) (< a 0)) nil)
     ((= (type a) 'INT) nil)
     (t (setq a 
          (read (getstring (strcat "Введите номер столбца " b ": ")))) t))
 ) a
)

(defun t34 (a b)
 (cond ((null a) (getint b))
       ((and (= (type a) 'INT) (>= a 0)) a)
       (t (initget (+ 1 2 4))
          (getint b)))
) 

(defun namfil (/ rf c fa)
 (while 
  (null rf)
  (prompt (strcat "Укажите имя файла (с расширением)/<"
                   (if (setq fa (last str$$)) fa "") ">: "))
  (setq rf (getstring))
  (if (and (= rf "") (/= nil fa))
      (setq rf fa)
  )
  (setq rtf$ (open rf "r"))
  (if rtf$
   (progn 
    (princ (strcat "\n file " rf
     "\n_______________________________________________________________________________")
    )
    (repeat 6 
     (setq c (read-line rtf$))
     (princ (strcat "\n" c)))
    (close rtf$)
    (setq rtf$ nil)
    (princ "\n______________________________________________________________________________")
   )             
   (progn (prompt "\nФайл не найден. ") (setq rf nil))
  )
 )
rf
)

(defun rfil (cx c cc) (float (nth (1- cx) c)))
(defun stu (cx cc) (* cx cc))

(defun point (cx cy c cc)
 (list (if (minusp cx) (stu (float (abs cx)) cc) (rfil cx c cc))
        (if (minusp cy) (stu (float (abs cy)) cc) (rfil cy c cc)))
)               

(defun inst (fa pol / ww c fp cx cy str s1 s2)
 (setq s1 (if pol "углов" "x-ов") s2 (if pol "радиус-векторов" "y-ов"))
 (setq str$$ 
  (mapcar '(lambda (x y z j) (eval (list x (if y y j) z)))
   '(t12 t12 t34 t34)
   (append (read (strcat "(" 
    (while (null str)
           (prompt (strcat "\n\nВведите номеpа столбцов "
                           s1 " и " s2 " или ? <"))
           (foreach e str$$ (if (numberp e) (progn (princ e) (prompt " "))))
           (write-char 8) (prompt ">: ")
           (setq str (getstring t))
           (if (= str "?") (progn (helpins s1 s2) (setq str nil)) str)
     )
                ")")) '(nil nil nil nil))
   (list s1 s2 "Введите номер начальной строки: "
             "Введите шаг выборки строк: ")
   str$$
  ) 
 )
 (setq str$$ (append str$$ (cons fa nil)))
 (if (setq ww (cadr (assoc str$$ fl$$))) 
     ($home ww)
     (progn 
      (setq rtf$ (open fa "r"))
      (setq cx (car str$$) cy (cadr str$$))
      (repeat (1- (caddr str$$)) (read-line rtf$))
      (setq c (read (strcat "(" (read-line rtf$) ")")))
      ($pu (point cx cy c 0) (cons 0 ($mfun ($nfun) nil)))
     )
 )
)

(defun seg (/ a) (setq a (alloc 1)) (alloc a) a) 

(defun draw (pt pol / ww cx cy mn sti)
 (setq cx (car str$$) cy (cadr str$$) 
  mn (cadr (assoc 'masht fl$$)) sti (1- (cadddr str$$)))
 (setq q$ ($home q$))
 (command "плиния")
 (while (setq ww ($next 'q$))
        (setq ww (mapcar '* ww mn))
        (if pol (setq ww (mpol ww)))
        (command (mapcar '+ pt ww))
 )
 (if rtf$ 
   (progn
    (while (setq ww (read-line rtf$))
           (setq ww (read (strcat "(" ww ")")) c$ (1+ c$))
           (setq q$ ($pu (setq ww (point cx cy ww c$)) q$))
           (setq ww (mapcar '* ww mn))
           (if pol (setq ww (mpol ww)))
           (command (mapcar '+ pt ww))
           (grtext -2 (strcat "Строка: " (itoa c$)))
           (repeat sti (read-line rtf$))
    )
    (setq fl$$ (cons (list str$$ q$) fl$$))
    (close rtf$)
    (setq rtf$ nil)
   )
 )
 (command)
)

(defun $nfun nil
 (read (strcat "$" (itoa (setq num$$ (1+ num$$)))))
)

(defun $mfun (nam sp)
 (eval (list 'defun nam nil sp))
)

(defun $pu (e nf / nn i x)
 (setq i (car nf) nf (cdr nf))  
 (cond ((< (length (setq x (fun nf))) seg$)
          (cons (1+ i) ($mfun nf (list 'quote (cons e x))))
       )
       (t ($mfun nf (list 'quote (cons (setq nn ($nfun)) x)))
          (cons 1 ($mfun nn (list 'quote (list e nf))))
       )
 )
)

(defun $home (nf / x)
 (setq nf (cdr nf))  
 (while (if (= (type (setq x (last (fun nf)))) 'SYM) nf)
        (setq nf x))
 (cons (length (fun nf)) nf)
)

(defun $next (nl / n nf x i)
 (setq nf (eval nl))
 (setq i (car nf) nf (cdr nf))
 (cond ((minusp (setq n (1- i))) nil)
        ((null (setq x (nth n (fun nf)))) nil)
        ((= (type x) 'SYM) 
                (set nl (cons (1- (length (fun x))) x))
                ($next nl))
        (t (set nl (cons n nf)) x)
  )
)

(defun mpol (pt) (polar '(0 0) (* pi (/ (car pt) 180)) (cadr pt)))

(defun sle (mod pol / ww pic cx cy a ah ae up sp
             w ms wl mfp n p pn nn m pt sti cor mn h aeo xc yc)
  (command "плиния")
  (princ "Введите начало координат или ?: ")
  (setq pic (/ (getvar "viewsize") (cadr (getvar "screensize")))
    sti (1- (cadddr str$$)) mn (cadr (assoc 'masht fl$$)) cx (car str$$)
    cy (cadr str$$)  wl '(nil) n 0 cor '(0 0) h (* 1.5 (getvar "viewsize"))
    h (list h h))
  (while (/= (car (grread t)) 5))
  (while (null pt)
    (setq a (grread t) ah (car a) ae (cadr a))
    (cond ((= ah 5)
            (if (not (equal ae aeo)) (setq aeo ae up nil)))
          ((= ah 3) (command ae) (setq pt (mapcar '- (getvar "lastpoint")
                     cor)))
          ((= ah 2) 
            (cond ((= ae 13) 
             (setq w (apply 'strcat (subst " " "," (reverse w)))
              ww (read (strcat "(" w ")")))
             (cond ((or (= w "m") (= w "M") (= w "м") (= w "М")) 
                      (setq ms t) (prompt "\nВведите масштаб <")
                      (princ (car mn)) (princ " ") 
                      (princ (cadr mn)) (prompt ">: "))
                   ((and (= w "") ms) (setq ms nil))
                   ((= w "нич") (command "" 
                      "привяжи" "нич" "плиния"))
                   ((not (null (member w 
                    '("нич" "кон" "сер" "цен" "узе" "ква" "пер" "твс" "нор" "кас" "бли" "быс"))))
                    (command "" "привяжи" w "плиния"))
                   ((= w "?") (helpsle))
                   ((= w "x") (setq xc (if (not xc) t) up nil m nil)) 
                   ((= w "y") (setq yc (if (not yc) t) up nil m nil))
                   ((and (numberp (car ww)) (numberp (cadr ww)))
                     (if ms 
                         (setq mn ww ms nil up nil)
                         (setq pt (mapcar '- ww cor) ms t)))
                   (t (princ " *Неверно*") (setq ms nil))
             )
             (if (not ms) 
                 (prompt (strcat "\nВведите начало координат или ?: "
                           (if xc "x: " "")
                           (if yc "y: " ""))))
             (setq w nil))
            ((= ae 8) 
              (if w (progn (setq w (cdr w))
                           (princ (strcat (chr 8) (chr 32) (chr 8))))))
            (t (setq w (cons (princ (chr ae)) w)))
           ))
         (t nil)
    )
    (cond (mod nil)
          ((not up)
            (cond ((null (setq ww (nth (setq nn (1+ n)) wl)))
                    (if (/= m mn) (setq m mn n 0 q$ ($home q$)
                         mfp (mapcar '* mn ($next 'q$))
                         mfp (if pol (mpol mfp) mfp) wl (cons mfp nil) 
                         cor (list (if xc (car mfp) 0) (if yc (cadr mfp) 0)))
                    )
                    (setq sp (mapcar '- aeo cor) up t 
                      p (mapcar '+ sp mfp)))
                  (t (grdraw (setq pn (mapcar '+ sp ww)) p -1) 
                     (setq n nn p pn))
            ))
          ((>= (setq nn (1- n)) 0)
            (setq pn (mapcar '+ sp (nth nn wl)))
            (grdraw p pn -1) 
            (setq n nn p pn))
          ((not (null (setq ww ($next 'q$))))
            (setq pn (mapcar '* mn ww) pn (if pol (mpol pn) pn))
            (if (> (distance (car wl) pn) (* 5 pic))
                (if (apply 'and (mapcar '(lambda (a b d) 
                            (< 0 (abs (- a b)) d)) pn cor h))
                    (setq wl (cons pn wl) n (1+ n)))))
          ((null rtf$) nil)
          ((not (null (setq ww (read-line rtf$))))
            (setq c$ (1+ c$))
            (if (setq ww (read (strcat "(" ww ")"))) 
             (progn
              (setq q$ ($pu (point cx cy ww c$) q$))
              (grtext -2 (strcat "Cтрока: "(itoa c$)))
              (repeat sti (read-line rtf$)))))
          ((not (null rtf$)) 
             (close rtf$) (setq rtf$ nil)
             (grtext -2 (strcat "Всего строк: " (itoa c$)))
             (setq fl$$ (cons (list str$$ q$) fl$$))) 
          (t nil)
    )
  )
  (prompt "\n")(command)
  (while (setq ww (nth (setq nn (1+ n)) wl))
         (setq pn (mapcar '+ sp ww))
         (grdraw pn p -1) 
         (setq n nn p pn)
  )
  (setq fl$$ (subst (list 'masht mn) (assoc 'masht fl$$) fl$$)) 
  pt
)       
  (defun plerr$$ (rt)                   
    (princ (strcat "Ошибка: " rt))
    (moder mlst$)
    (if (= (type rtf$) 'FILE) (close rtf$))
    (setq rtf$ nil)
    (setq *error* olerr$$)
    (princ)
  )

(defun c:PLIN (/ pol q$ mlst$ pt c$ rtf$ seg$ nfi)
  
  (setq olerr$$ *error* *error* plerr$$)
  (setq mlst$ (modes '("BLIPMODE" "CMDECHO" "OSMODE")))
  (setq seg$ (/ (seg) 3))
  (initget "полярная ортогональная")
  (if (= (getkword "Введите имя системы координат /Орт/Пол <Орт>: ")
          "полярная")
      (setq pol t))
  (setq nfi (namfil)) 
  (setq q$ (inst nfi pol))
  (graphscr)
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setq c$ 0)
  (if (= (getvar "dragmode") 0)
      (setq pt (sle t pol))
      (setq pt (sle nil pol))) 
  (setvar "osmode" 0)
  (draw pt pol) 
  (moder mlst$)
  (setq *error* olerr$$)
  (princ) 
)
(princ "C:PLIN")
(princ)

[plaz]

Александр, сочувствую :wink:

[Александр]

Спасибо Alex_k лиспина работает.
With the best regards , Alex