[S_Misha]

Коллеги, не поможете с Lisp для рисования прямоугольника по 2м точкам(точки расположены по диагонали). Очень нужен (приходится очень много оцифровывать планшетов).

А команда _RECTANG (ПРЯМОУГОЛЬНИК) не подходит?

[hwd]

Сообщение от S_Misha Коллеги, не поможете с Lisp для рисования прямоугольника по 2м точкам(точки расположены по диагонали). Очень нужен (приходится очень много оцифровывать планшетов).

точки указаны во внешнем текстовом файле?

[E-degtyarev]

Для запуска команда re_f.
Может сгодится?

[S_Misha]

Нет команда Прямоугольник не подходит
Нудно чтоб я ткнул 2 точки образующие диагональ прямоугольника и он отрисовался по этим данным. Прямоугольники могут быть повернутя под любым углом. точки находятся не в текстовом файле, указываются с экрана. ТУт был выложен набор pltools, для работы с полилиниями, там была очень похожая команда, для отрисовки прямоугольника по 3м точкам. Нужен похожий Lisp, но для 2-х точек.

[Profan]

Прямоугольники могут быть повернутя под любым углом.

Из-за этого условия задача становится неопределенной. Для режима ОРТО можно было бы написать программу.

[Makswell]

Угу, условий явно не достаточно для однозначного решения.

[S_Misha]

Да наверно нельзя это сделать, Чтото я не подумал, что может несколько прямоуголников с одной диагональю быть. Все, закрываем тему.

[VVA]

Сообщение от S_Misha Да наверно нельзя это сделать, Чтото я не подумал, что может несколько прямоуголников с одной диагональю быть.

Именно поэтому в pltools требуется указать 3 точки

[Alex II]

Помогите пожалуйста.
Когдато здесь на форум мне написали лисп для отрисовки прямоугольника по двум точкам (середина первой стороны и середина противоположной стороны) с заданной высотой и на заданном слое. Хотелось бы дополнить этот лисп:
Сейчас он рисует толко в мировой системе координат, хотелось бы в любой (может менять систему координат на мировую перед отрисовкой, а потом обратно на предыдущую?). Также хотелосьбы чтобы тип линни слоя был dashed. И если можно, то line type scale нарисованного прямоугольника была бы 0,1.

Код:

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

(defun c:gilza (/ P1 P2 V)
 (setq p1 (getpoint "\n Nachalnaja tochka")
       p2 (getpoint "\n Konechnaja tochka")
       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")
     (8 . "Proekt_gilza")
     (410 . "Model")
     (100 . "AcDbPolyline")
     (90 . 4)
     (70 . 1)
     (43 . 0.1)
    )
   (mapcar
    'cons
    '(10 10 10 10)
    (mapcar 'mapcar '(- + + -) (list p1 p1 p2 p2) (list v v v v))
   ) ;_  mapcar
  ) ;_  append
 ) ;_  entmakex
)

спасибо!

[Alan]

Что мешает вначале поставить:
(command "_UCS" "_W")
запомнить переменные "LTYPE" и "LTSCALE", затем их назначить
(setvar "LTYPE" "dashed")
(setvar "LTSCALE" 0.1)
в конце вернуть, типа
(command "_UCS" "_P") и переменные "LTYPE" и "LTSCALE"
???

[Alex II]

Мешает только одно незнание lispa. Но спасибо за подсказку, постараюсь осилить
И еще вопросик. Если посреди исполнения функции нажимаетса Esc и происходит выход, то можно ли сделать чтоб автоматом возвращались (command "_UCS" "_P") и переменные "LTYPE" и "LTSCALE"

[Кулик Алексей aka kpblc]

http://autolisp.ru/2009/09/20/howto_undo/
http://autolisp.ru/2009/09/13/error-catch/

[Олег (jr.)]

Сообщение от Alex II И еще вопросик. Если посреди исполнения функции нажимаетса Esc и происходит выход, то можно ли сделать чтоб автоматом возвращались (command "_UCS" "_P") и переменные "LTYPE" и "LTSCALE"

Попробуй где-то так, особо не проверял

Код:

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

(defun c:gilza (/ *error* cec clay clt clw cmd csc osm p1 p2 v)
    (defun *error*  (msg)
      (command "_undo" "_end")
      (command)
      (if (and msg
	       (wcmatch	msg
			"Function cancelled,quit / exit abort,console break"))
	(princ
	  (strcat "\nError: " msg)
	  )
	)
      (if clay
	(setvar 'clayer clay))
      (if cec
	(setvar 'cecolor cec))
      (if clt
	(setvar 'celtype clt))
      (if clw
	(setvar 'celweight clw))
      (if csc
	(setvar 'celtscale csc))
      (if cmd
	(setvar 'cmdecho cmd))
      (if osm
	(setvar 'osmode osm))
         (if	(tblsearch "ucs" "MyWorkingUCS")

	      (command "_ucs" "_Delete" "MyWorkingUCS")
	      )
      ) ;_*error*
  
;; вспомогательная ф-ция
(defun load_ltype (ltname / fname)
  ;FH
  (and
    (if (zerop (getvar "measureinit"))
    (setq fname "acad.lin")
    (setq fname "acadiso.lin")
  )
  (command "._-linetype" "_Load" ltname (findfile fname) "")
    )
  );_load_ltype

;; вспомогательная ф-ция   
;; by VovKa as published:  
;; http://www.theswamp.org/index.php?topic=33041.msg384927#msg384927
(defun CreateLayer (Name FrzLock Color LType Plot? LWeight Desc)
  
  (entmakex
    (list (cons 0 "LAYER")
	  (cons 100 "AcDbSymbolTableRecord")
	  (cons 100 "AcDbLayerTableRecord")
	  (cons 2 Name)
	  (cons 70 FrzLock)
	  (cons 62 Color)
	  (cons 6 LType)
	  (cons 290 Plot?)
	  (cons 370 LWeight)
	  (list -3 (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 Desc)))
    )
  )
)
  ;; 			main program			  ;;
  
  (command "_undo" "_Begin")
(if (tblsearch "ucs" "MyWorkingUCS")
  (command "_ucs" "_Restore" "MyWorkingUCS")
  (progn
    (command "_ucs" "_Named" "_Save" "MyWorkingUCS")
    (command "_ucs" "_Restore" "MyWorkingUCS")
    (command "_ucsicon" "_ON" "_ucsicon" "_ORigin")
    )
  )

  
   (command "_ucs" "_W")
  
(setq osm (getvar 'osmode)
      cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(setq clay (getvar 'clayer)
      cec  (getvar 'cecolor)
      clt  (getvar 'celtype)
      clw  (getvar 'celweight)
      csc  (getvar 'celtscale)
      )

  
 (if (not (tblsearch "ltype" "hidden"))
   (load_ltype "hidden")
   )

 (if (not (tblsearch "layer" "Proekt_gilza"))
   (CreateLayer
     "Proekt_gilza"
     0
     7 ;цвет черный (7)
     "hidden"
     1
     -1
     "Слой для отрисовки гильз")		  
   )
 (setvar 'clayer "Proekt_gilza")
 (setvar 'cecolor "bylayer")
 (setvar 'celtype "bylayer")
 (setvar 'celweight -1)
 (setvar 'celtscale 0.1)
  
 (setq p1 (getpoint "\n Nachalnaja tochka >>"))
 (setq p2 (getpoint p1 "\n Konechnaja tochka >>"))
       (if (and p1 p2)
	 (progn
	   (setq 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")
		 (8 . "Proekt_gilza")
		 (6 . "HIDDEN")
		 (410 . "Model")
		 (100 . "AcDbPolyline")
		 (90 . 4)
		 (70 . 1)
		 (48 . 0.1)
		 (43 . 0.1)
		 )
	       (mapcar
		 'cons
		 '(10 10 10 10)
		 (mapcar 'mapcar
			 '(- + + -)
			 (list p1 p1 p2 p2)
			 (list v v v v))
		 ) ;_  mapcar
	       ) ;_  append
	     ) ;_  entmakex

	   )
	 )
 (*error* nil)
  (princ)  
)