рисование прямоугольника

рисование прямоугольника · 15.07.2008, 23:26

Не могли бы Вы мне помоч написать лисп, который чертил бы прямоугольник по двум точкам. Первая - это середина одной стороны, вторая - середина противоположной, причём длины этих двух сторон равнялись бы 0,8, а толщина полилинии 0,3? Заранее благодарен!

Donhuan · 16.07.2008, 00:32

Код:

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

;;;Igor Kireev (Donhuan) 07.2008. Для dwg.ru.
;;;mail: igkiv@tut.by
;;;Отрисовка прямоугольника по двум точкам, расположенным посередине противоположных сторон
;;;point_1 - первая точка
;;;point_2 - вторая точка
;;;lengt_side - длина каждой сторон, на которых расположены точки
;;;Пример вызова функции: (polig_4 '(0 0) '(5 5) 10)
(defun polig_4 (point_1 point_2 lengt_side / point_1_1 point_1_2 point_2_1 point_2_2 mspace)
  (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  ((lambda (x y)
    (setq point_1_1 (polar point_1 (+ (angle point_1 point_2) x) y))
    (setq point_1_2 (polar point_1 (- (angle point_1 point_2) x) y))
    (setq point_2_1 (polar point_2 (+ (angle point_2 point_1) x) y))
    (setq point_2_2 (polar point_2 (- (angle point_2 point_1) x) y))
  ) (/ pi 2) (/ lengt_side 2.0))
  (setq vla_line (vla-AddLightWeightPolyline mspace (p4:list->variantArray (apply 'append (list point_1_1 point_1_2 point_2_1 point_2_2)))))
  (vla-put-lineweight vla_line acLnWt030)
  (vla-put-Closed vla_line t)
)

; создание varianta из списка точек пример из helpa
(defun p4:list->variantArray (ptsList / )
  (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptsList) 1))) ptsList))
)

CB · 16.07.2008, 09:26

И что означает эта фраза

Цитата:

причём длины этих двух сторон равнялись бы 0,8

?

Alex II · 16.07.2008, 10:00

Donhuan, спасибо, тока пишет почемуто: ; error: too few arguments

Цитата:

Сообщение от CB

И что означает эта фраза
?

ето означаэт что длина сторон, на которых задаютса точки, равны 0,8 единитс чертежа каждая (то есть всё время постоянная, не надо вводить каждый раз при запуске программы), длина других двух сторон равна соответственно расстоянию между заданных точек

Donhuan · 16.07.2008, 11:01

Мало аргументов передаешь функции. Есть же пример запуска функции в шапке. Наверное забываешь передавать длину сторон, сделал чтобы ее можно было менять для универсальности.

Alex II · 16.07.2008, 11:02

Цитата:

Сообщение от Donhuan

Мало аргументов передаешь функции. Есть же пример запуска функции в шапке. Наверное забываешь передавать длину сторон, сделал чтобы ее можно было менять для универсальности.

da, vsjo ok, ne zametil primer zapuska, spasibo!

Елпанов Евгений · 16.07.2008, 11:19

другой вариант, пожалуй, будет покороче...

Код:

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

(defun c:test (/ P1 P2 V)
 (setq p1 (getpoint "\n Укажите середину первой стороы")
       p2 (getpoint "\n Укажите середину второй стороны")
       v  (/ (distance p1 p2) 0.4)
       v  (mapcar '/ (mapcar '- p1 p2 '(0 0)) (list v v))
       v  (list (- (cadr v)) (car v))
 ) ;_  setq
 (entmakex
  (append
   '((0 . "LWPOLYLINE")
     (100 . "AcDbEntity")
     (410 . "Model")
     (100 . "AcDbPolyline")
     (90 . 4)
     (70 . 1)
     (43 . 0.3)
    )
   (mapcar
    'cons
    '(10 10 10 10)
    (mapcar 'mapcar '(- + + -) (list p1 p1 p2 p2) (list v v v v))
   ) ;_  mapcar
  ) ;_  append
 ) ;_  entmakex
)

Alex II · 16.07.2008, 13:08

Da, eto to chto nuzhno, bol'shoje spasibo

Donhuan · 16.07.2008, 23:28

Цитата:

Сообщение от Елпанов Евгений

другой вариант, пожалуй, будет покороче...

Не могли бы Вы пояснить алгоритм Вашего решения, а то работает, а как не совсем понимаю.

Елпанов Евгений · 17.07.2008, 10:03

Цитата:

Сообщение от Donhuan

Не могли бы Вы пояснить алгоритм Вашего решения, а то работает, а как не совсем понимаю.

Не могу сказать, что с большим удовольствием, но надеюсь достаточно понятно. Всевозможные комментарии - моя слабая сторона...

Код:

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

(defun c:test (/ P1 P2 V)
 ;; Описание алгоритма работы программы
 (setq ;; Вычисляем две точки
       p1 (getpoint "\n Укажите середину первой стороы")
       p2 (getpoint "\n Укажите середину второй стороны")
       ;; Вычисляем коэфициент, во сколько раз расстояние между точками
       ;; больше половины стороны (0.8)
       v  (/ (distance p1 p2) 0.4)
       ;; вычисляем вектор смещения, между точками
       ;; при вычитании, я использовал еще одну точку с координатами 0,0
       ;; это позволило отбросить Z измерение в векторе
       ;; и укоротил вектор до длинны 0.4 единицы
       ;; получился вектор длинной 0.4
       ;; и с направлением равым углу из второй в первую точку
       v  (mapcar '/ (mapcar '- p1 p2 '(0 0)) (list v v))
       ;; поворачиваем вектор на 90 градусов, против часовой стрелки
       v  (list (- (cadr v)) (car v))
 ) ;_  setq
 ;; собственно создание полилинии, используя коды dxf 
 (entmakex
  (append
   '((0 . "LWPOLYLINE")
     (100 . "AcDbEntity")
     (410 . "Model")
     (100 . "AcDbPolyline")
     (90 . 4)
     (70 . 1)
     (43 . 0.3)
    )
   ;; добавляем ко всем четырем точкам код 10 в начало
   (mapcar
    'cons
    '(10 10 10 10)
    ;; делаем смещение точек вектором в обе стороны, т.е. +/- 0.4
    (mapcar 'mapcar '(- + + -) (list p1 p1 p2 p2) (list v v v v))
   ) ;_  mapcar
  ) ;_  append
 ) ;_  entmakex
)

Donhuan · 17.07.2008, 21:08

Спасибо. Сейчас все понятно.

dextron3 · 18.07.2008, 16:44

Alex II, объясни для чего тебе это нужно, может тоже возьму на вооружение?

Елпанов Евгений · 18.07.2008, 17:17

Цитата:

Сообщение от dextron3

Alex II, объясни для чего тебе это нужно, может тоже возьму на вооружение?

По моему, все понятно...
Вот примерчик из темы
http://www.theswamp.org/index.php?topic=12692.15
фотки я приложу - их нельзя увидеть без регистрации...

dextron3 · 18.07.2008, 17:20

Елпанов Евгений, это что китайский проджект студио?

Елпанов Евгений · 18.07.2008, 17:25

Цитата:

Сообщение от dextron3

Елпанов Евгений, это что китайский проджект студио?

Нет, это автокад плюс довески...
В указанной мной теме, Chen просил помочь сделать аналог этих функций на лиспе, хотел заменить чужие arx, которые давно не обновлялись под новые версии акада...

Елпанов Евгений · 18.07.2008, 17:33

Вот пример моего ответа в той теме (форум частично закрытый и я не уверен, что лиспы видно без регистрации). Но свои то программы, я могу показывать!

Код:

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

(defun c:test (/ A D D0 E EN GR LST LST1 LST2 PT)
  ;;by ElpanovEvgeniy at theswamp.org
  ;;change very little by qjchen
  ;; 30-09-2006
  ;; http://www.theswamp.org/index.php?topic=12692.0
  ;; The last changes 
  ;; The task (3) is solved
  
  (setq pt (getpoint "\nthe steel start point:"))
  (setq
    en
         (entmakex
           '((0 . "LWPOLYLINE")
             (100 . "AcDbEntity")
             (67 . 0)
             (410 . "Model")
             (8 . "0")
             (62 . 1)
             (100 . "AcDbPolyline")
             (90 . 5)
             (70 . 0)
             (43 . 10.0)
             (38 . 0.0)
             (39 . 0.0)
             (10 50.0 20.0)
             (42 . 0.0)
             (10 0. 20.0)
             (42 . 1.0)
             (10 0. 0.0)
             (42 . 0.0)
             (10 0.0 0.0)
             (42 . 1.0)
             (10 0.0 20.0)
             (42 . 0.0)
             (10 -50. 20.0)
             (42 . 0.0)
             (210 0.0 0.0 1.0)
            )
         ) ;_  entmakex
    lst1 '((50. 20.)
           (0. 20.)
           (0. 0.)
          )
    lst2 '((0. 0.)
           (0. 20.)
           (-50. 20.)
          )
    e
         (reverse (vl-member-if
                    (function
                      (lambda (x)
                        (= (car x) 39)
                      ) ;_  lambda
                    ) ;_  function
                    (reverse (entget en))
                  ) ;_  vl-member-if
         ) ;_  reverse
  ) ;_  setq
  (while (= (car (setq gr (grread nil 5 1))) 5)
    (setq a (angle pt (cadr gr))
          d (distance pt (cadr gr))
    ) ;_  setq
    (setq
      lst (append
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (* (car p) (cos a))
                       (* (cadr p) (- (sin a)))
                       (car pt)
                    ) ;_  list
                    (+ (* (car p) (sin a))
                       (* (cadr p) (cos a))
                       (cadr pt)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst1
            ) ;_  mapcar
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (* (+ d (car p)) (cos a))
                       (* (cadr p) (- (sin a)))
                       (car pt)
                    ) ;_  list
                    (+ (* (+ d (car p)) (sin a))
                       (* (cadr p) (cos a))
                       (cadr pt)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst2
            ) ;_  mapcar
          ) ;_  append
    ) ;_  setq
    (entmod
      (append
        e
        (list
          (cons 10 (car lst))
          '(42 . 0.)
          (cons 10 (cadr lst))
          '(42 . 1.)
          (cons 10 (caddr lst))
          '(42 . 0.)
          (cons 10 (cadddr lst))
          '(42 . 1.)
          (cons 10 (nth 4 lst))
          '(42 . 0.)
          (cons 10 (nth 5 lst))
          '(42 . 0.)
        ) ;_  list
      ) ;_  append
    ) ;_  entmod
  ) ;_  while
  (setq
    pt   (mapcar (function -) (cadr lst) (caddr lst))
    a    (angle (caddr lst) (cadr lst))
    d0   (distance (cadr lst) (caddr lst))
    lst1 (list (car lst) (cadr lst) (nth 4 lst) (nth 5 lst))
    lst2 (list (caddr lst) (cadddr lst))
  ) ;_  setq
  (setq en (entmakex (entget en)))
  (while (= (car (setq gr (grread nil 5 0))) 5)
    (setq d (polar pt
                   a
                   (-
                     (distance (cadr gr)
                               (vlax-curve-getClosestPointTo
                                 en
                                 (cadr gr)
                               ) ;_  vlax-curve-getClosestPointTo
                     ) ;_  distance
                     d0
                   ) ;_  -
            ) ;_  polar
    ) ;_  setq
    (setq
      lst (append
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (car p)
                       (car d)
                    ) ;_  list
                    (+ (cadr p)
                       (cadr d)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst1
            ) ;_  mapcar
            (mapcar
              (function
                (lambda (p)
                  (list
                    (- (car p)
                       (car d)
                    ) ;_  list
                    (- (cadr p)
                       (cadr d)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst2
            ) ;_  mapcar
          ) ;_  append
    ) ;_  setq
    (entmod
      (append
        e
        (list
          (cons 10 (car lst))
          '(42 . 0.)
          (cons 10 (cadr lst))
          '(42 . 1.)
          (cons 10 (nth 4 lst))
          '(42 . 0.)
          (cons 10 (nth 5 lst))
          '(42 . 1.)
          (cons 10 (caddr lst))
          '(42 . 0.)
          (cons 10 (cadddr lst))
          '(42 . 0.)
        ) ;_  list
      ) ;_  append
    ) ;_  entmod
  ) ;_  while
  (princ)
)

dextron3 · 18.07.2008, 17:45

Елпанов Евгений, о супер, похоже на динблоки!, а с линиями можно такое же придумать а не с полилиниями?

Ну тоже самое только чертить в текущем слое и берет толщину линии в текущем слое, но из отдельных приметивов, пример:

PS Это для прорисовки шпильки

Елпанов Евгений · 18.07.2008, 17:52

Цитата:

Сообщение от dextron3

Елпанов Евгений, о супер, похоже на динблоки!, а с линиями можно такое же придумать а не с полилиниями?

Ну тоже самое только чертить в текущем слое и берет толщину линии в текущем слое, но из отдельных приметивов, пример:

PS Это для прорисовки шпильки

Конечно можно!
Сразу оговорюсь, у меня нет времени на такие задачки, тем более, что ваша просьба полностью решена в моей программе - надо только подредактировать. Другими словами, я разрешаю всем желающим, изменять мой код, для создания необходимых программ. Возможно, кто нибудь и для вашего примера сделает...

ps. Не забывайте ссылки на меня и тему:
http://www.theswamp.org/index.php?topic=12692.15

dextron3 · 18.07.2008, 17:59

Елпанов Евгений, а в чем приемущество данной команды в сравнении с офсетом?

Alex II · 22.07.2008, 10:14

Цитата:

Сообщение от dextron3

Alex II, объясни для чего тебе это нужно, может тоже возьму на вооружение?

Да на самом деле всё просто

проектирую трубопроводы, а для изображения гильз на генплане теперь использую данную функцию

ПС А можно ли дополнить эту команду так, чтоб при её запуске образовывался новый слой (например с именем "гильза", или если такой слой уже есть, то просто бы включался), в котором и рисоваласбы данная гильза, а после завершения команды возвращался бы предыдущий слой? Или я всё слишком усложняю?

15.07.2008, 23:26		#1
рисование прямоугольника Alex II Регистрация: 27.11.2007 Сообщений: 126 Не могли бы Вы мне помоч написать лисп, который чертил бы прямоугольник по двум точкам. Первая - это середина одной стороны, вторая - середина противоположной, причём длины этих двух сторон равнялись бы 0,8, а толщина полилинии 0,3? Заранее благодарен!
Просмотров: 5531

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
точное рисование в автокаде	Alexfoto333	AutoCAD	77	26.03.2007 09:00
Изменение прямоугольника а-ля Viewport.	Mikhail	AutoCAD	13	20.10.2004 10:41
ADT 2004 - рисование	ViС	Прочее. Программное обеспечение	2	05.04.2004 07:29
Рисование в масштабе "по масштабу"	Boris	AutoCAD	7	28.03.2004 07:15
Рисование в масштабе "по масштабу"	Boris	AutoCAD	2	18.03.2004 17:25