| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > прямоугольник по 3 точкам

прямоугольник по 3 точкам

Ответ
Поиск в этой теме
Непрочитано 28.12.2006, 14:54 #1
прямоугольник по 3 точкам
Neznayka
 
Регистрация: 24.03.2005
Сообщений: 320

Есть в Spotlight такая замещательная кнопочка... мне б такую...
это похоже на отрисовку 4-угольного многоугольника по стороне, только там всегда квадрат получается, т.к. не возможности выбора высоты прямоугольника
Просмотров: 22697
 
Непрочитано 28.12.2006, 15:02
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Уж не _polygon ли имеется в виду?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 28.12.2006, 15:51
#3
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 320


Цитата:
Сообщение от kpblc
Уж не _polygon ли имеется в виду?
_polygon в русском акаде и есть многоугольник, а про многоугольник я писал выше, что он по такому принципу только квадраты рисует
[ATTACH]1167310294.GIF[/ATTACH]
Neznayka вне форума  
 
Непрочитано 28.12.2006, 16:23
#4
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Что-то типа такого
Код:
[Выделить все]
(defun C:R3P ( / *error* pt1 pt2 pt1W pt2W ucs ucf osm isRus)
  (defun *error* (msg)(princ msg)
    (if ucs (command "_.UCS" "_P")) ;_ end of if
    (if osm (setvar "OSMODE" osm)) ;_ end of if
    (setvar "UCSFOLLOW" ucf)(princ)) ;_ end of defun
  (vl-load-com)
  (setq isRus (= (getvar "DWGCODEPAGE") "ANSI_1251")
          ucf (getvar "UCSFOLLOW"))
  (setvar "UCSFOLLOW" 0)
  (initget 1)
  (setq pt1 (getpoint
              (if isRus
                "\nПервая точка прямоугольника:"
                "\nThe first point of a rectangular:"
              ) ;_ end of if
            ) ;_ end of getpoint
  ) ;_ end of setq
  (initget 1)
  (setq pt2 (getpoint pt1
                      (if isRus
                        "\nВторая точка прямоугольника:"
                        "\nThe second point of a rectangular:"
                      ) ;_ end of if
            ) ;_ end of getpoint
  ) ;_ end of setq
  (setq pt1W (trans pt1 1 0)
        pt2W (trans pt2 1 0)
         osm (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setq ucs (vl-cmdf "_.UCS"
                     "_N"
                     "_3"
                     pt1
                     pt2
                     (polar pt2 (+ (angle pt1 pt2) (* 0.5 PI)) 10)
            ) ;_ end of vl-cmdf
  ) ;_ end of setq
  (setvar "CMDECHO" 1)
  (command "_.RECTANGLE"
           (trans pt1W 0 1)
           ".X"
           (trans pt2W 0 1)
  ) ;_ end of command
  (setvar "OSMODE" osm)
  (command pause)
  (if ucs (command "_.UCS" "_P")) ;_ end of if
  (setvar "UCSFOLLOW" ucf)
  (princ)
) ;_ end of defun
(if (= (getvar "DWGCODEPAGE") "ANSI_1251")
  (princ "\nНаберите R3P в командной строке")
  (princ "\nType R3P to run commnad")
) ;_ end of if
(princ)
VVA вне форума  
 
Автор темы   Непрочитано 28.12.2006, 17:02
#5
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 320


О -да это то что надо, но есть вопросы:
нет повтора по пробелу .
не корректно работает если ПСк уже "крученое", т.е отличается от МСК
Neznayka вне форума  
 
Автор темы   Непрочитано 28.12.2006, 17:15
#6
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 320


и как повесить это на кнопку,
и проверьте почту
Neznayka вне форума  
 
Непрочитано 28.12.2006, 17:27
#7
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Ну так там очепятка закралась.
Исправил. Код VVA №4

Нет повтока по пробелу - враки
VVA вне форума  
 
Непрочитано 28.12.2006, 17:56
#8
Zouss


 
Регистрация: 14.03.2006
Сообщений: 863


а зачем изобретать ТАКОЙ велосипед?

обычная команда _rectang, после указания первой угла выбираем опцию Dimensions
но вот беда - acad просит длину и ширину прямоугольника (число с клавиатуры или 2 точки мышью), а не точки
выход простой, в ответ на первый запрос пишем (getvar "lastpoint") и изображаем макрос типа
Код:
[Выделить все]
^C^C_rectang \D (getvar "lastpoint") \(getvar "lastpoint") \(getvar "lastpoint")
Zouss вне форума  
 
Автор темы   Непрочитано 28.12.2006, 18:21
#9
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 320


Цитата:
Сообщение от VVA
Ну так там очепятка закралась.
Исправил. Код VVA №4

Нет повтока по пробелу - враки

ну не знаю как с пробелом такое вышло, сейчас все хорошо

Zouss,
я вас не понял , ваш макрос обыкновенный прямоуг. рисует
Neznayka вне форума  
 
Непрочитано 28.12.2006, 19:36
#10
Клетчатый


 
Регистрация: 17.08.2005
Сообщений: 62


В "Тулпак" - команда DDR
Клетчатый вне форума  
 
Непрочитано 29.12.2006, 02:04
#11
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


У VVA лучше чем в Toolpac, логичнее.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 29.12.2006, 02:08
#12
KAI

геологоразведка, строительство
 
Регистрация: 14.10.2003
Магадан
Сообщений: 311


>>VVA
Только вот оЧепятка "Втокая точка..."
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 30.12.2006, 12:00
#13
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>KAI Спасибо, исправил + исправил некоторые огрехи типа initget. Возможно добавил новые :?:
VVA вне форума  
 
Непрочитано 14.12.2010, 06:28
#14
rain_day


 
Регистрация: 02.10.2008
Сообщений: 198


Хочу продолжить тему о прямоугольниках. Кто работал в SolidWorks знает, как замечательно там организовано построение прямоугольника. Кто не работал - посмотрите прилагаемое изображение, это лучше, чем я буду пытаться объяснить. Вопрос мой заключается понятно в чем...может, кто подскажет что-то подобное для автокада? Освоив лисп от VVA в этой теме, я уверен, что это возможно. Но, не нашел...
Миниатюры
Нажмите на изображение для увеличения
Название: Безымянный.JPG
Просмотров: 336
Размер:	12.6 Кб
ID:	49969  
rain_day вне форума  
 
Непрочитано 14.12.2010, 08:52
#15
Disney

Геодезист
 
Регистрация: 12.03.2009
Сибирь (где медведи по улицам ходят)
Сообщений: 860
Отправить сообщение для Disney с помощью Skype™


Мой вариант, построение по существующим точкам.
Цитата:
Если выбрать 3 точки, то по ним и четвёртой, вычисленной, будет построен параллелограмм.
Если указать 4 точки, то тупо по ним будет построен четырёхугольник.
[IMG]http://s56.***********/i151/1009/8b/c123e23a70ab.gif[/IMG]

Код:
[Выделить все]
(defun C:4_ugolnik (/ points)
  (while
    (princ "\nВыбирете точки <Выход>:")
     (setq points (ssget "_:L" '((0 . "POINT"))))
     (setq
       points
	(mapcar
	  '(lambda (x)
	     (reverse (cdr (reverse (cdr (assoc 10 (entget x))))))
	   )
	  (vl-remove-if-not
	    '(lambda (x) (= (type x) 'ENAME))
	    (mapcar 'cadr (reverse (ssnamex points)))
	  )
	)
     )
     (cond
       ((< (length points) 3)
	(princ "\nМинимум 3 точки")
       )
       ((eq (length points) 3) (parallelogram points))
       ((eq (length points) 4) (quadrilateral points))
       (T (princ "\nМаксимум 4 точки"))
     )
  )
)

 ;|
Функция parallelogram
|;
(defun parallelogram (points / t1 t2 t3 d1 d2 d3)
  (setq	t1 (car points)
	t2 (cadr points)
	t3 (caddr points)
	d1 (distance t1 t2)
	d2 (distance t2 t3)
	d3 (distance t3 t1)
  )
  (ru-pline-entmake
    (cond
      ((eq d1 (max d1 d2 d3))
       (list t2 t3 t1 (polar t1 (angle t3 t2) d2))
      )
      ((eq d2 (max d1 d2 d3))
       (list t3 t1 t2 (polar t2 (angle t1 t3) d3))
      )
      (T (list t1 t2 t3 (polar t3 (angle t2 t1) d1)))
    )
    T
    nil
  )
)
 ;|
Функция quadrilateral
|;
(defun quadrilateral (points / t1 t2 t3 t4)
  (setq	t1 (car points)
	t2 (cadr points)
	t3 (caddr points)
	t4 (cadddr points)
  )
  (ru-pline-entmake
    (if
      (inters t1 t2 t3 t4)
       (list t1 t3 t2 t4)
       (if (inters t1 t3 t2 t4)
	 (list t1 t2 t3 t4)
	 (list t1 t2 t4 t3)
       )
    )
    T
    nil
  )
)

 ;|
Функция ru-pline-entmake
|;

(defun ru-pline-entmake
			(points is_closed is_3d / elst ENTL)
;;; (ru-pline-entmake (список_вершин) флаг_замкнутости
;;; флаг_делать_3М_ПЛИНИЮ)
;;; возвращает имя примитива - полилинии или NIL, если что-то не
;;; вышло.
  ;|
Пример:
(ru-pline-entmake
(list
(list 220.65 345.001)
(list 332.622 546.525)
(list 846.376 320.906)
(list 719.035 121.572)
) T nil )
|;
  (if is_3d
    (progn
      (setq entl
	     (list
	       '(0 . "POLYLINE")
	       '(100 . "AcDbEntity")
	       '(100 . "AcDb3dPolyline")
	       '(66 . 1)
	       '(10 0.0 0.0 0.0)
	       (cons 70
		     (logior 8
			     (if is_closed
			       1
			       0
			     ) ;_ end of if
			     (if (= 1 (getvar "PLINEGEN"))
			       128
			       0
			     ) ;_ end of if
		     ) ;_ end of logior
	       ) ;_ end of cons
	     ) ;_ end of list
      ) ;_ end of setq
      (if (entmake entl)
	(progn
	  (foreach v points
	    (progn
	      (setq entl
		     (list
		       '(0 . "VERTEX")
		       '(100 . "AcDbEntity")
		       '(100 . "AcDbVertex")
		       '(100 . "AcDb3dPolylineVertex")
		       (append '(10) v)
		       '(70 . 32)
		     ) ;_ end of list
	      ) ;_ end of setq
	      (entmake entl)
	    ) ;_ end of progn
	  ) ;_ end of foreach
	  (if (entmake '((0 . "SEQEND") (100 . "AcDbEntity")))
	    (entupd (entlast))
	    nil
	  ) ;_ end of if
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      (setq elst (append
		   (list
		     '(0 . "LWPOLYLINE")
		     '(100 . "AcDbEntity")
		     '(100 . "AcDbPolyline")
					;(cons 8 (getvar "CLAYER"))
		     (cons 90 (length points))
		     (cons 70
			   (logior (if is_closed
				     1
				     0
				   ) ;_ end of if
				   (if (= 1 (getvar "PLINEGEN"))
				     128
				     0
				   ) ;_ end of if
			   ) ;_ end of logand
		     )			; _ end of cons;;;
		   ) ;_ end of list
		   (mapcar '(lambda (p)
			      (list 10 (car p) (cadr p))
			    ) ;_ end of lambda
			   points
		   ) ;_ end of mapcar
		 ) ;_ end of append
      ) ;_ end of setq
      (if (entmake elst)
	(entupd (entlast))
	nil
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(princ "\nВызов команды: 4_ugolnik")
__________________
Почему все вдруг становятся умными, когда уже не надо?
Disney вне форума  
 
Непрочитано 14.12.2010, 09:00
#16
rain_day


 
Регистрация: 02.10.2008
Сообщений: 198


Тоже здорово. Только пока не придумал для чего это мне может пригодиться
rain_day вне форума  
 
Непрочитано 14.12.2010, 09:27
#17
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,327


невыносимо трудно развернуть систему координат относит. оси Z, указав две точки _ucs _z
а потом вернуться в мировую _ucs пробел
Хмурый вне форума  
 
Автор темы   Непрочитано 14.12.2010, 09:50
#18
Neznayka


 
Регистрация: 24.03.2005
Сообщений: 320


rain_day, вы посмотрите что Disney работает в геодезии. Это точки выброшенные в тахеометра.
Хмурый, задолбешься ПСК крутить. Думаете в деревне дома по красной линии посажены?
Disney, СПАСИБО!
Neznayka вне форума  
 
Непрочитано 14.12.2010, 09:50
#19
rain_day


 
Регистрация: 02.10.2008
Сообщений: 198


Neznayka, да, я вижу. Я ж про себя

Хмурый, Ты это кому и для чего? Как это может помочь в обсуждаемых задачах?
rain_day вне форума  
 
Непрочитано 14.12.2010, 09:58
#20
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 16,327


rain_day, да никак не поможет, если ПСК крутить не можешь или не хочешь. Можно обойтись без этих костылей вовсе.
_ucs - один из основных инструментов, как и привязка From (От)
Хмурый вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > прямоугольник по 3 точкам

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск