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

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

Рисование отрезка сразу в обе стороны

Ответ
Поиск в этой теме
Непрочитано 21.06.2009, 15:48 #1
Рисование отрезка сразу в обе стороны
Дмитрий Факс
 
Технолог
 
Новокузнецк
Регистрация: 10.11.2008
Сообщений: 52

Вечер добрый, господа форумчане. Собственно вопрос в заголовке. Вот в Автокад Механикал есть такая команда. Т.е. нажал курсором на центр допустим окружности, и рисуется прямая в обе стороны. А в автокаде есть такое? Если нет, то пожалуйста, может кто лисп такой сделает. Очень удобная штука. Заранее благодарен.
Просмотров: 3732
 
Непрочитано 21.06.2009, 17:42
#2
asys

архитектор
 
Регистрация: 10.08.2005
Ростов-на-Дону
Сообщений: 5,279


XLINE
asys вне форума  
 
Непрочитано 21.06.2009, 18:59
#3
engngr

сети
 
Регистрация: 03.11.2008
Московия*
Сообщений: 5,763


Отрезок в обе стороны я себе еще представляю: два симметричных отрезка при отрисовке только одного из низ. А вот прямая в обе стороны... это как?
engngr вне форума  
 
Автор темы   Непрочитано 22.06.2009, 04:53
#4
Дмитрий Факс

Технолог
 
Регистрация: 10.11.2008
Новокузнецк
Сообщений: 52
<phrase 1=


XLINE не подходит. Нужно именно отрезок. Чтобы нажал на место предполагаемого центра отрезка, потом указал в какую сторону нужно отрезок провести, вводишь длину половину длины отрезка и рисуется отрезок с заданной длиной. Да, т.е. отрезок, но зеркально отображенный.
Дмитрий Факс вне форума  
 
Непрочитано 22.06.2009, 08:34
#5
Victor


 
Регистрация: 14.06.2009
Бат-Ям
Сообщений: 295


Могу сделать такую прогу, но любопытство заело, почему половина а не треть или одна десятая?
Victor вне форума  
 
Автор темы   Непрочитано 22.06.2009, 09:22
#6
Дмитрий Факс

Технолог
 
Регистрация: 10.11.2008
Новокузнецк
Сообщений: 52
<phrase 1=


Потому что надо из центра, допустим окружности, провести ось. Сделаешь такую прогу буду очень признателен.
Дмитрий Факс вне форума  
 
Непрочитано 22.06.2009, 09:31
#7
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,824
<phrase 1=


Цитата:
Сообщение от Дмитрий Факс Посмотреть сообщение
Потому что надо из центра, допустим окружности, провести ось. Сделаешь такую прогу буду очень признателен.
_dimcenter пробовал???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 22.06.2009, 10:02
#8
Victor


 
Регистрация: 14.06.2009
Бат-Ям
Сообщений: 295


Так пойдёт?
Код:
[Выделить все]
(defun c:l2l( / my_line spis_l kor_10 kor_11 dis pnt)
(command "_.line")
(while (> (getvar "CMDACTIVE") 0)(command pause))
(setq my_line (entlast))
(setq spis_l (entget  my_line)) ;
(setq kor_10 (cdr (assoc 10 spis_l))) 
(setq kor_11 (cdr (assoc 11 spis_l)))
(setq dis (distance kor_10 kor_11))
(setq pnt (list my_line kor_10))
(command "_.lengthen" "_DE" dis pnt "")
)
Victor вне форума  
 
Непрочитано 22.06.2009, 10:05
#9
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


Наверное, проще всего так:
Код:
[Выделить все]
(defun c:o2 ()
(setq cen (getpoint "\nУкажите середину отрезка"))
(setq p1 (getpoint cen "\nУкажите половину длины:"))
(command "_line" p1 (polar p1 (angle p1 cen) (* 2 (distance cen p1)))"")
)
E-degtyarev вне форума  
 
Непрочитано 22.06.2009, 10:21
#10
Сергей Дубина


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


Попробуй сделать динамический блок
__________________
КазнитьØнельзяØпомиловать:eek:
Сергей Дубина вне форума  
 
Непрочитано 22.06.2009, 10:24
#11
Денис Флюстиков


 
Регистрация: 20.07.2005
СПб
Сообщений: 89


Программка для рисования осюшек:
http://dwg.ru/dnl/306
Денис Флюстиков вне форума  
 
Непрочитано 22.06.2009, 10:59
#12
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Если без ком-методов (привязки и прочие грабли):
Код:
[Выделить все]
(vl-load-com)
(defun c:test ( / pt1 pt2)
(setq pt1 (getpoint "\nCentr ") pt2 (getpoint pt1 "\n End"))
(vla-startundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
(entmakex (list (cons 0 "line") (cons 10 (polar pt2 (angle pt2 pt1) (* 2 (distance pt1 pt2)))) (cons 11 pt2)))
(vla-endundomark (vlax-get-property (vlax-get-acad-object) 'ActiveDocument))
);end of defun
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 22.06.2009, 11:38
#13
луки


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


А вот пример макроса, который выполнит то, что вы требуете. Нужно толко выбрать окружность и ввести вторую точку либо сделав left-click, либо с клавиатуры. К сожалению просто ввести дистанцию не получится, но можно ввести "@необходимая_дистанция,0" для горизонтального отрезка и "0,@необходимая_дистанция" для вертикального (естественно без ковычек ) В общем всего два клика и линия готова

Код:
[Выделить все]
^C^Ccal;start_p=cen;\cal;end_p=cur;\_line;'cal;start_p-(end_p -start_p);!end_p;;

Последний раз редактировалось луки, 22.06.2009 в 13:41.
луки вне форума  
 
Автор темы   Непрочитано 22.06.2009, 22:23
#14
Дмитрий Факс

Технолог
 
Регистрация: 10.11.2008
Новокузнецк
Сообщений: 52
<phrase 1=


Всем огромное спасибо за ответы. Оччень помогли. Даже больше, чем я ожидал. Но взял на вооружение линию Димы_. То что надо.
Дмитрий Факс вне форума  
 
Непрочитано 23.06.2009, 09:19
#15
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Вот еще вариант:
Код:
[Выделить все]
(defun C:twol ( / pt1 dlina)
(vl-load-com)
(setq pt1 (getpoint "\n Укажите точку: "))
(princ "\n Укажите направление и длину полуотрезка: ")
(vl-cmdf "_line" pt1 pause "")
(setq dlina (vlax-get-property (vlax-ename->vla-object (entlast)) 'length))
(vl-cmdf "_lengthen" "_de" dlina pt1 "")
(princ)
)
Profan вне форума  
 
Непрочитано 23.06.2009, 11:39
#16
VVA

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


Вариация на тему two1: не используются vla методы, код стал короче, можно оформить макросом
Код:
[Выделить все]
(defun C:two2 ( )
(princ "\n Укажите направление и длину полуотрезка: ")
(command "_line" pause pause "")
(command "_lengthen" "_percent" 200 (list (entlast)(cdr(assoc 10 (entget(entlast))))) "")
(princ)
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 23.06.2009, 12:01
#17
Jonas

конструктор машиностроитель
 
Регистрация: 14.05.2007
Новосибирск
Сообщений: 893


Давно пользуюсь замечательной програмой Денича Флюстикова.



;|====================================================

Отрисовка осей окружностей (дуг, эллипсов) и осевой линии при выборе отрезков

Программа Дениса Флюстикова "Axis_Den" от 27.10.06
Новое:
Если первом выборе указать точку вне объектов,
то запрашивается область, где будут отрисованы оси у всех окружностей

Макрос для кнопки: ^C^C^P(load "Axis_Den");Axis_Den
Замечания и предложения по адресу [email protected]

====================================================|;

Код:
[Выделить все]
(defun C:Axis_Den (/ aa aa0 aa1 aa2 aa3 bb bb0 bb1 bb2 bb3 tmp ang centr layer dist osmode)

(princ "\nВыбрать объект <Указать точки>:")

(setq layer "оси" ; Слой создания
      dist 3      ; Длина выступа осевых линий
      aa (cadr (grread nil 4 2))
      osmode (getvar "OSMODE")
      tmp nil
      aa1 nil)

(if (eq (type aa) 'LIST)(progn

(setq aa0 (ssget aa))

(if aa0 (progn

(setq aa0 (ssname aa0 0)
      aa0 (list aa0 aa))

(while (and (/= aa1 "LINE")(/= aa1 "ELLIPSE")(/= aa1 "ARC")(/= aa1 "CIRCLE"))

(if tmp (setq aa0 (entsel "\nПервый отрезок или круг, дуга, эллипс:")))

(setq aa (entget (car aa0))
      aa2 (cdr (assoc 0 aa))
      tmp 0
      aa3 0
      bb1 (cdr (assoc 8 aa)))

(if  (and (/= aa2 "LINE")(/= aa2 "ELLIPSE")(/= aa2 "ARC")(/= aa2 "CIRCLE")(/= aa2 "3DSOLID"))(progn

(setvar "CMDECHO" 0)
(if (= (cdr (assoc 70 (tblsearch "Layer" bb1))) 4)(progn
(command "_.layer" "_u" bb1 "")
(setq tmp 1)))

(while (not (eq (entlast) aa3))

(setq tmp (1+ tmp)
      aa3 (entlast))

(vl-cmdf "_.explode" (cadr aa0))

(if (setq aa (ssget (cadr aa0)
'((-4 . "<OR")(0 . "LINE")(0 . "ELLIPSE")(0 . "ARC")(0 . "CIRCLE")(-4 . "OR>"))))
(setq aa (entget (ssname aa 0))
      aa3 (entlast)))

(while (= (getvar 'cmdactive) 1)
(vl-cmdf ""))
)

(vl-cmdf "_.undo" tmp)
(setvar "CMDECHO" 1)
))
(setq aa1 (cdr (assoc 0 aa)))
)

(setq aa1 (cdr (assoc 10 aa))
      aa2 (cdr (assoc 11 aa))
      aa3 (cdr (assoc 40 aa))
      bb1 0)

(if aa3 (progn

(setvar "CMDECHO" 0)
(vl-cmdf "_.undo" "_g")

(if aa2
(setq ang (angle '(0 0) aa2)
      aa2 (distance '(0 0) aa2))
(setq ang 0
      aa2 aa3
      aa3 1))

(setq aa1 (mapcar '+ aa1 '(0 0))
      bb (getvar "CLAYER")
      bb0 (ssadd))

(setvar "OSMODE" 0)

(if (= (tblsearch "Layer" layer) nil)
(vl-cmdf "_.'layer" "_m" layer "_c" 3 ""  "_l" "ACAD_ISO4W100" "" "")
(vl-cmdf "_.'layer" "_s" layer ""))

(repeat 2
(repeat 2
(setq aa0 (polar aa1 ang (+ aa2 dist))
      ang (+ ang pi))

(entmake (list (cons 0 "LINE")
	       (cons 10 aa1)
	       (cons 11 aa0)
	       (cons 62 256)
	       (cons 370 -1)
	       (cons 6 "BYLAYER")))

(setq bb0 (ssadd (entlast) bb0))
)
(setq aa2 (* aa2 aa3)
      ang (+ ang (/ pi 2))) 
)

(setvar "CLAYER" bb)

(setq aa1 (trans aa1 0 1)
      aa0 (trans aa0 0 1))

(princ "\nДлина осевых линий <Без изменения>:")

(vl-cmdf "_.scale" bb0 "" aa1 "_r" aa1 aa0 (distance aa1 aa0)
	 "_.scale" bb0 "" aa1 "_r" aa1 aa0)

(setvar "OSMODE" osmode)
(setq aa1 (vl-cmdf pause))
(setvar "OSMODE" 0)

(if (= (getvar 'cmdactive) 1)
(setq aa1 (vl-cmdf aa0))
(if (null aa1)
(vl-cmdf "_.erase" bb0 "")
))

(if aa1 (progn
(setq aa2 (entget (entlast))
      aa3 (cdr (assoc 10 aa2))
      aa2 (cdr (assoc 11 aa2))
      aa2 (distance aa3 aa2)
      aa2 (/ aa2 (getvar "LTSCALE"));
      aa2 (/ aa2 18))
(if (< aa2 (getvar "CELTSCALE"))
(command "_.change" bb0 "" "_p" "_s" aa2 ""))
))

(setvar "OSMODE" osmode)
(vl-cmdf "_.undo" "_e")
(setvar "CMDECHO" 1)
)
(progn
(while (/= bb1 "LINE")

(setq aa2 (cdr (assoc 11 aa))
      bb0 (entsel "\nВторой отрезок:")
      bb (entget (car bb0))
      bb1 (cdr (assoc 8 aa))
      bb2 (cdr (assoc 0 bb))
      bb3 0
      tmp 0)

(if  (and (/= bb2 "LINE")(/= bb2 "3DSOLID"))(progn

(setvar "CMDECHO" 0)
(if (= (cdr (assoc 70 (tblsearch "Layer" bb1))) 4)(progn
(command "_.layer" "_unl" bb1 "")
(setq tmp 1)))

(while (not (eq (entlast) bb3))

(setq tmp (1+ tmp)
      bb3 (entlast))

(vl-cmdf "_.explode" (cadr bb0))

(if (setq bb (ssget (cadr bb0) '((0 . "LINE"))))
(setq bb (entget (ssname bb 0))
      bb3 (entlast)))

(while (= (getvar 'cmdactive) 1)
(vl-cmdf ""))
)

(vl-cmdf "_.undo" tmp)
(setvar "CMDECHO" 1)
))
(setq bb1 (cdr (assoc 0 bb)))
)

(setq bb1 (cdr (assoc 10 bb))
      bb2 (cdr (assoc 11 bb))
      bb1 (mapcar '+ bb1 '(0 0))
      bb2 (mapcar '+ bb2 '(0 0))
      centr (inters aa1 aa2 bb1 bb2 nil))

(if centr
(progn
(if (< (distance centr aa1)(distance centr aa2))
(setq tmp aa1
      aa1 aa2
      aa2 tmp))

(if (< (distance centr bb1)(distance centr bb2))
(setq tmp bb1
      bb1 bb2
      bb2 tmp))

(setq ang (/ (+ (angle aa1 aa2)(angle bb1 bb2)) 2)
      bb (polar centr ang 1)
      aa (inters aa1 bb1 centr bb nil)
      bb (inters aa2 bb2 centr bb nil))

(if bb
(if (and (null (inters aa centr (cadr aa0) (cadr bb0)))
(null (inters aa bb (cadr aa0) (cadr bb0))))
(setq ang (+ (/ pi 2) ang)
      bb (polar centr ang 1)
      aa (inters aa1 bb2 centr bb nil)
      bb (inters aa2 bb1 centr bb nil)))
(setq bb centr))
)
(progn
(if (inters aa1 bb1 aa2 bb2)
(setq tmp aa1
      aa1 aa2
      aa2 tmp))

(setq aa (mapcar '/ (mapcar '+ aa1 bb1) '(2 2))
      bb (mapcar '/ (mapcar '+ aa2 bb2) '(2 2)))
))

(setq ang (angle aa bb)
      aa (polar aa ang (- dist))
      bb (polar bb ang dist))

(setvar "CMDECHO" 0)
(vl-cmdf "_.undo" "_g")

(setq bb2 (getvar "CLAYER"))
(setvar "OSMODE" 0)

(if (= (tblsearch "Layer" layer) nil)
(vl-cmdf "_.'layer" "_m" layer "_c" 3 ""  "_l" "ACAD_ISO4W100" "" "")
(vl-cmdf "_.'layer" "_s" layer ""))

(entmake (list (cons 0 "LINE")
	       (cons 10 aa)
	       (cons 11 bb)
	       (cons 62 256)
	       (cons 370 -1)
	       (cons 6 "BYLAYER")))

(setq aa2 (entlast)
      aa (trans aa 0 1)
      bb (trans bb 0 1))

(setvar "CLAYER" bb2)

(setvar "OSMODE" osmode)
(princ "\nНачальная точка осевой линии <Без изменения>:")

(vl-cmdf "_.scale" aa2 "" aa "_r" aa bb (distance aa bb)
	 "_.scale" aa2 "" aa "_r" aa bb)

(setvar "OSMODE" osmode)
(setq aa1 (vl-cmdf pause))
(setvar "OSMODE" 0)

(if (= (getvar 'cmdactive) 1)
(vl-cmdf bb)
(if (null aa1)
(setq ang nil)))

(if ang (progn

(setq bb (cdr (assoc 11 (entget aa2)))
      bb (trans bb 0 1))

(princ "\nКонечная точка осевой линии <Без изменения>:")
(vl-cmdf "_.scale" aa2 "" bb "_r" bb aa)

(setvar "OSMODE" osmode)
(setq aa1 (vl-cmdf pause))
(setvar "OSMODE" 0)

(if (= (getvar 'cmdactive) 1)
(setq aa1 (vl-cmdf aa))
(if (null aa1)
(vl-cmdf "_.erase" aa2 "")))

(if aa1 (progn
(setq aa1 (entget aa2)
      aa3 (cdr (assoc 10 aa1))
      aa1 (cdr (assoc 11 aa1))
      aa1 (distance aa3 aa1)
      aa1 (/ aa1 (getvar "LTSCALE"));
      aa1 (/ aa1 36))
(if (< aa1 (getvar "CELTSCALE"))
(command "_.change" aa2 "" "_p" "_s" aa1 ""))
))
)
(vl-cmdf "_.erase" aa2 ""))

(setvar "OSMODE" osmode)
(vl-cmdf "_.undo" "_e")
(setvar "CMDECHO" 1)
)))
(progn
;
(setq aa0 (getcorner aa "\nУкажите область с окружностями:")
      aa0 (ssget "_W" aa aa0 '((0 . "CIRCLE"))))

(if aa0 (progn

(setvar "CMDECHO" 0)
(command "_.undo" "_g")
(setq bb (getvar "CLAYER")
      bb1 (getvar "LTSCALE")
      bb2 (getvar "CELTSCALE"))

(if (= (tblsearch "Layer" layer) nil)
(vl-cmdf "_.'layer" "_m" layer "_c" 3 ""  "_l" "ACAD_ISO4W100" "" "")
(vl-cmdf "_.'layer" "_s" layer ""))

(while (/= 0 (sslength aa0))

(setq aa3 (ssname aa0 0)
      aa0 (ssdel aa3 aa0)
      aa1 (entget aa3)
      aa2 (ssadd aa3)
      centr (cdr (assoc 10 aa1))
      aa1 (sslength aa0))

(while (> aa1 0)
(setq aa1 (1- aa1)
      aa4 (ssname aa0 aa1)
      aa3 (entget aa4)
      aa3 (cdr (assoc 10 aa3)))
(if (equal aa3 centr 0.1)
(setq aa2 (ssadd aa4 aa2)
      aa0 (ssdel aa4 aa0)))
)

(setq aa3 (cdr (assoc 40 (entget (ssname aa2 0)))))

(repeat (1- (sslength aa2))

(setq tmp (cdr (assoc 40 (entget (ssname aa2 1))))
      aa2 (ssdel (ssname aa2 0) aa2))

(if (< aa3 tmp)
(setq aa3 tmp))

)

(setq aa3 (+ aa3 dist)
      bb0 (/ aa3 bb1)
      bb0 (/ bb0 18)
      ang 0)

(if (< bb0 bb2)
(setvar "CELTSCALE" bb0))

(repeat 4
(setq aa (polar centr ang aa3)
      ang (+ ang (/ pi 2)))

(entmake (list (cons 0 "LINE")
	       (cons 10 centr)
	       (cons 11 aa)
	       (cons 62 256)
	       (cons 370 -1)
	       (cons 6 "BYLAYER")))
)
(setvar "CELTSCALE" bb2)
)
(setvar "CLAYER" bb)
(command "_.undo" "_e")
(setvar "CMDECHO" 1)
)
(princ "\nОкружности не найдены") 
))))
(progn

(setq aa1 (getpoint "\nПервая точка на осевой линии:")
      bb2 (getvar "CLAYER"))

(setvar "CMDECHO" 0)
(vl-cmdf "_.undo" "_g")

(initget 7)
(if (not (vl-catch-all-error-p
(setq aa0 (vl-catch-all-apply 'getpoint (list aa1 "\nВторая точка на осевой линии:")))))(progn
(setq aa0 (trans aa0 1 0)
      aa1 (trans aa1 1 0)
      ang (angle aa1 aa0)
      aa2 (polar aa0 ang dist)
      aa3 (polar aa1 ang (- dist))
      aa1 (mapcar '/ (mapcar '+ aa1 aa0) '(2 2 2)))

(setvar "OSMODE" 0)

(if (= (tblsearch "Layer" layer) nil)
(vl-cmdf "_.'layer" "_m" layer "_c" 3 ""  "_l" "ACAD_ISO4W100" "" "")
(vl-cmdf "_.'layer" "_s" layer ""))

(princ "\nДлина осевой линии <Без изменения>:")

(entmake (list (cons 0 "LINE")
	       (cons 10 aa2)
	       (cons 11 aa3)
	       (cons 62 256)
	       (cons 370 -1)
	       (cons 6 "BYLAYER")))
(setvar "CLAYER" bb2)

(setq aa3 (entlast)
      aa1 (trans aa1 0 1)
      aa2 (trans aa2 0 1))

(vl-cmdf "_.scale" aa3 "" aa1 "_r" aa1 aa2 (distance aa1 aa2)
	 "_.scale" aa3 "" aa1 "_r" aa1 aa2)

(setvar "OSMODE" osmode)
(setq aa1 (vl-cmdf pause))
(setvar "OSMODE" 0)

(if (= (getvar 'cmdactive) 1)
(setq aa1 (vl-cmdf aa2))
(if (null aa1)
(vl-cmdf "_.erase" aa3 "")))

(if aa1 (progn
(setq aa1 (entget aa3)
      aa2 (cdr (assoc 10 aa1))
      aa1 (cdr (assoc 11 aa1))
      aa1 (distance aa2 aa1)
      aa1 (/ aa1 (getvar "LTSCALE"));
      aa1 (/ aa1 36))
(if (< aa1 (getvar "CELTSCALE"))
(command "_.change" aa3 "" "_p" "_s" aa1 ""))
))

))

(setvar "OSMODE" osmode)
(vl-cmdf "_.undo" "_e")
(setvar "CMDECHO" 1)
))
(princ)
)

Последний раз редактировалось Солидворкер, 23.06.2009 в 19:11.
Jonas вне форума  
 
Непрочитано 23.06.2009, 13:55
#18
VVA

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


Jonas, Ссылка дана автором в #11
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Рисование отрезка сразу в обе стороны

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

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