Нужен лиспик по черчению бергштрихов(не для откосов)
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен лиспик по черчению бергштрихов(не для откосов)

Нужен лиспик по черчению бергштрихов(не для откосов)

Ответ
Поиск в этой теме
Непрочитано 09.11.2006, 11:57 #1
Нужен лиспик по черчению бергштрихов(не для откосов)
Иван
 
Музыка,строительство(проектирование)
 
Москва
Регистрация: 25.05.2004
Сообщений: 40

ДД!МОжет есть у кого-нить лисп для черчения бергшрихов.Имеем кучу горизонталей,к которым надо прорисовать бергшрихи.
Ориентировочно вот такой:
1.Выбор обекта(ов) (линии,сплайны)
2.размер бергштриха
3.Указать направление
Отрисовка из центра объекта

Заранее сенгс откликнувшимся)))
Просмотров: 19865
 
Непрочитано 09.11.2006, 12:37
#2
Кулик Алексей aka kpblc
Moderator

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


Отрисовка из центра - это круто. Для приколу: найди центры представленых примитивов.
[ATTACH]1163065045.dwg[/ATTACH]
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 09.11.2006, 13:10
#3
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от kpblc
Отрисовка из центра - это круто. Для приколу: найди центры представленых примитивов.
[ATTACH]1163065045.dwg[/ATTACH]
У каждого объекта есть центр.Сложные объекты состоят из нескольких простых.Соответсвенно у полилинии и сплайна нужно несколько бергштрихов.Ну да черт с ними со сложными,хотя бы к линиям из центра.А для сложных - через точку вставки
Иван вне форума  
 
Непрочитано 09.11.2006, 13:15
#4
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


А может все же не из цента, а парпандекулярно объектам
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Автор темы   Непрочитано 09.11.2006, 13:41
#5
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от DEM
А может все же не из цента, а парпандекулярно объектам
Все пральна,объектам перпендикулярно,но перпендикуляр из центра :wink: Вообщем,мне надо выделить энное количество объектов,задать в какую сторону будет смотреть бергштрих и чтобы из центра их объектов,в указанную сторону выросли палочки мною заданной длины Это применительно к простым линиям.
К сложным объектам,перпендикуляр к указанной точке заданной длины.
Иван вне форума  
 
Непрочитано 09.11.2006, 17:53
#6
Zouss


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


на конкурс за звание примитивнейшей проги
Код:
[Выделить все]
(defun c:m1 (/)					       ;обзовите запускающую команду как хотите
  (berg)
) ;_  defun

(defun berg (/)
  (setq	ss (ssget) ;_  ssget
	n  (sslength ss)
	i  0
	l  (getdist "задайте дистанцию между бергштрихами")
  ) ;_  setq
  (repeat n
    (setq ssi (ssadd (ssname ss i))
	  i   (1+ i)
    ) ;_  setq
    (command "MEASURE" ssi "BLOCK" "BERG" "Y" l)
  ) ;_  repeat
) ;_  defun
в файле должен присутствовать блок с именем BERG (прилагается ниже)

изменение размера бергштрихов с помощью редактирования масштаба вставки блоков, изменение ориентации бергштрихов с помощью изменения знака масштаба вставки по оси Y (положительный/отрицательный/средний)
[ATTACH]1163084034.dwg[/ATTACH]
Zouss вне форума  
 
Автор темы   Непрочитано 09.11.2006, 18:17
#7
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Спасибо за отклик ,только мне нужна не отрисовка забора,а именно бергштрих для горизонтали.Последовательность действий такая:
1.Выделите объект(ы)
2.Укажите размер бергштриха
3.Укажите направление бергштриха
И по итогу все горизонтали(в данном случае,просто Line) обзаводятся палочками той длины,которую я укажу и того направления,куда я тыкну.причем появиться они должны из центра этих линий.

P/S А Ваш лисп-это имитация команды Меasure :wink:
Иван вне форума  
 
Непрочитано 09.11.2006, 18:40
#8
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


Блин скачайте себе СПДС.
Там есть функция Сварка и работает она с плилиниями.
Правда штрихи одинаковые но вам пойдеть Я думаю.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Автор темы   Непрочитано 09.11.2006, 18:43
#9
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от DEM
Блин скачайте себе СПДС.
Там есть функция Сварка и работает она с плилиниями.
Правда штрихи одинаковые но вам пойдеть Я думаю.
Что это?Да и если одинаковые,то не подойдет.Да и нужно указание направления и именно из центра
Иван вне форума  
 
Непрочитано 10.11.2006, 06:44
#10
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,372


Иван, зачем зацикливаться на каком-то мифическом "центре", тем более, не зная, что такое СПДС?

Не надо топографу ничего знать ни про какие центры. Думаешь первому пришла идея рисовать берг-штрихи программно?

А делаются они именно так, как показал Zouss - используя разбивку примитива блоком. И ничего, вызывающего улыбку, в этом нет. Все дополнительные программы, в конце концов являются "имитациями" команд и их последовательностей.

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

Расставленные автоматом берг-штрихи, как правило, не полностью удовлетворят топографа. Так лишние можно просто стереть. А чтобы в характерных точках склона (ярко выраженный хребет) непременно были штрихи, можно добиться небольшим совершенствованием программы, или отдельной маленькой программой для одиночных штрихов.

Штрихи рисуются не "из центра", а по нормали к линиям.

Если же не устраивает "имитация", можно поступить просто - изучить ObjectARX, создать свой объект "ГОРИЗОНТАЛЬ", который сам будет рисоваться со штрихами, надписями отметок, и от "центра".
ShaggyDoc вне форума  
 
Непрочитано 10.11.2006, 08:35
#11
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,837


Цитата:
Сообщение от ShaggyDoc
можно поступить просто - изучить ObjectARX
Да уж проще некуда.
И че люди здесь дурью маются, делов-то...
Krieger вне форума  
 
Непрочитано 10.11.2006, 08:41
#12
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


Хм ну сделайте вы тогда тип линии свой.
Отрезки с дугами преобразуйте в единую полилинию с помощью Экспрес Тулс.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 10.11.2006, 09:07
#13
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,837


Я хэть и не топограф, но по опыту работы со спортивными картами, надо что-то типа такого: (см.картинку)
Как тут типом линии или одной нормальностью обойтись?
[ATTACH]1163138855.gif[/ATTACH]
Krieger вне форума  
 
Непрочитано 10.11.2006, 09:13
#14
Кулик Алексей aka kpblc
Moderator

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


> Krieger : достаточно давно была тема по поводу получения попиндикуляру к кривой от указанной точки, там вроде как было и лисповое решение.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 10.11.2006, 10:57
#15
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Я понимаю,что лисп-это всего навсего последовательность стандартных команд,только вот незадача-я не умею пока писать его. :cry: Вот и решил спросить,может есть у кого такой лиспик,не один же я занимаюсь вертикальной планировкой.
Насчет размера бергштриха я и не замарачиваюсь,можно и одной длины,например 0,5.
Вообщем ситуэйшин такой.Имеем вариант 1,в идеале нужен вариант 3.Спрашивал я про 2(хотелось просто выделить все горизонтали,указать направление и размер и чтобы вар1 превратился в вар2 )
Если все же кто-нить сможет написать (ну очень простой лиспик со слов некоторых участников :wink: )буду очень признателен.
[ATTACH]1163145442.dwg[/ATTACH]
Иван вне форума  
 
Непрочитано 10.11.2006, 12:05
#16
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


Черт его знает, что у вас там в файле, у меня открылась лишь одна линия.
Из центра чет не получается, а если подойдут перпендикуляры к кривой то можно и написать.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Автор темы   Непрочитано 10.11.2006, 12:13
#17
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от DEM
Черт его знает, что у вас там в файле, у меня открылась лишь одна линия.
Из центра чет не получается, а если подойдут перпендикуляры к кривой то можно и написать.
ну хз,вроде загружается.От перпендикуляров к кривой тоже не откажусь Перпендикуляр к указанному месту заданной длины?
Иван вне форума  
 
Непрочитано 10.11.2006, 14:07
1 | #18
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


1. Про перпендикуляры
LISP. Построение перпендикуляров к любым линейным примитивам
2. Про бергштрихи
Код:
[Выделить все]
(defun C:M1 ( / adoc *error* selset len Fpt Spt Mpt ang what par)
(defun *error* (msg)(vla-Regen adoc acActiveViewport)(vla-EndUndoMark adoc))
;********************************
; Векторное произведение векторов
;********************************
; W1, W2 - вектора
; Возвращает: вектор нормали к плоскости заданной векторами  в правой системе координат.
;W1 и W2 не должны лежать на одной прямой).
(defun 3d_Wnorm (W1 W2)(list (- (* (cadr W1)(caddr W2))(* (caddr W1)(cadr W2)))
        (- (* (caddr W1)(car W2)) (* (car W1)(caddr W2)))(- (* (car W1)(cadr W2)) (* (cadr W1)(car W2)))))
(defun group-by-num (lst num / ls ret)
 (if (= (rem (length lst) num ) 0)(progn (setq ls nil)
  (repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls)
  lst (cdr lst)))(setq ret (append ret (list (reverse ls))) ls nil))))
  ret)
(defun getcoors (obj / objname crs)(setq objname (vla-get-ObjectName obj) crs (cond
 ((= objname "AcDbLine")(list (vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj)))
 ((wcmatch objname "*Polyline")((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam obj))
  (setq lst (append lst (list (vlax-curve-getPointAtParam obj i))))) lst)))
((= objname "AcDbSpline")(group-by-num (vlax-safearray->list(vlax-variant-value(vla-get-fitpoints obj))) 3))
(t nil))))
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-StartUndoMark adoc)(princ "\nВыберите горизонтали ")
(if (setq selset (ssget "_:L" '((0 . "*LINE"))))(progn
  (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))))
  (foreach item lst (setq crs (getcoors item) Fpt (car crs))
   (while (setq crs (cdr crs))(setq Spt (car crs))
    (setq par (+(* (- (if (cdr crs)(vlax-curve-getParamAtPoint item Spt)
			(vlax-curve-getEndParam item))
		(vlax-curve-getParamAtPoint item Fpt)) 0.5)
		    (vlax-curve-getParamAtPoint item Fpt)))
     (if (null len)(progn (initget 6)(setq len (getdist "\nРазмер бергштриха <0.5>: "))
        (if (null len)(setq len 0.5))(initget 1)(setq Mpt (getpoint
            (trans (vlax-curve-getPointAtParam item par) 0 1) "\nНаправление бергштриха: ")
            Mpt (trans Mpt 1 0) Mpt (mapcar '- Mpt Fpt) ang (mapcar '- Spt Fpt)
            ang (last (3d_Wnorm ang Mpt)))(if (minusp ang)(setq what -)(setq what +))))
	(setq ang (what (angle (setq Mpt (vlax-curve-getPointAtParam item par))
			 (vlax-curve-getPointAtParam item (+ par 0.0001)))
	            (* 0.5 PI)))
	(vla-AddLine (vla-get-block (vla-get-ActiveLayout adoc))
	  (vlax-3d-point Mpt)(vlax-3d-point (polar Mpt ang len)))
	(setq Fpt Spt)))
(vla-EndUndoMark adoc)))(princ))
(princ "\nНаберите в командной строке M1")
Обрабатывает LINE, all Polyline, Spline
VVA вне форума  
 
Непрочитано 10.11.2006, 14:28
#19
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


VVA
Блин а Я тут мучусь _.divide думал так лучше получится, правда Я там блок применял.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 10.11.2006, 15:11
#20
Alxd

Разработчик САПР
 
Регистрация: 14.05.2004
Тюмень
Сообщений: 467
<phrase 1=


У меня есть такая программулька.
(defun c:sht( / ang abas sel obj pnt pnt1 pnt2 flg snp cmd scl)

(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_.undo" "_begin")

(setq snp (getvar "OSMODE"))
(setvar "OSMODE" 16417)

(setq abas (getvar "ANGBASE"))
(setq scl (getscl))
(setq obj (entsel "\nУкажи местоположение штриха на линии : "))
(setq pnt (cdr obj))
(setq obj (car obj))
(if (/= (cdr (assoc '0 (entget obj))) "LINE") (quit))
(setq ang (angle (cdr (assoc '10 (entget obj))) (cdr (assoc '11 (entget obj)))))
(if (and (> ang 1.5708) (< ang 4.71239))
(setq flg 1)
(setq flg 0)
)
(setq pnt1 (polar (car pnt) (+ ang 1.5708) (* 1.0 scl)))
(setq pnt (inters (car pnt) pnt1 (cdr (assoc '10 (entget obj))) (cdr (assoc '11 (entget obj))) nil))
(setvar "ANGBASE" ang)
(setq sel (getangle pnt "\nС какой стороны ставить текст?"))
(if (= flg 0)
(if (and (> sel 0) (< sel 3.14))
(setq pnt1 (polar pnt (+ ang 1.5708) (* 1.0 scl)))
(setq pnt1 (polar pnt (- ang 1.5708) (* 4.0 scl)))
)
(if (and (> sel 0) (< sel 3.14))
(setq pnt1 (polar pnt (+ ang 1.5708) (* 4.0 scl)))
(setq pnt1 (polar pnt (- ang 1.5708) (* 1.0 scl)))
)
)
(if (and (> sel 0) (< sel 3.14))
(setq pnt2 (polar pnt (- ang 1.5708) (* 2.0 scl)))
(setq pnt2 (polar pnt (+ ang 1.5708) (* 2.0 scl)))
)
(setq sel (getstring T "\nТекст : "))
(if (= flg 0)
; (command "_.text" "_j" "_c" pnt1 (* 3.0 scl) 0.0 sel)
; (command "_.text" "_j" "_c" pnt1 (* 3.0 scl) 180.0 sel)
(command "_.text" "_j" "_c" pnt1 2000 0.0 sel)
(command "_.text" "_j" "_c" pnt1 2000 180.0 sel)
)

(command "_.line" pnt pnt2 (command))

(command "_.undo" "_end")
(setvar "ANGBASE" abas)
(setvar "CMDECHO" cmd)
(setvar "OSMODE" snp)
(princ)
)
(princ)

надеюсь пригодится
Alxd вне форума  
 
Автор темы   Непрочитано 10.11.2006, 16:00
#21
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


2VVA Низкий поклон те Проги работают,рулез.
А мона попросить дописать
Чтобы наряду с бергштрихом под горизонталью появлялся DText со всеми своими функциями акромя угла наклона,так как он уже задан.Значения по умолчанию-стиль как и обычно,высота - 1,25 , текст-99. Чтобы получилось,как в 3 варианте,только с подписанными горизонтальками 99. Буду очень признателен,если не затруднит. :roll:

2Alxd Чет то ли я не понимаю,толи не фурычит
Иван вне форума  
 
Непрочитано 10.11.2006, 17:44
#22
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Код:
[Выделить все]
(defun RTD (a)(/ (* a 180.0) pi))
(defun mip-var-clear-osnap ()(setq *MIP-OSNAP* (getvar "OSMODE"))(setvar "OSMODE" 0))
(defun mip-var-restore-osnap ()(if *MIP-OSNAP* (setvar "OSMODE" *MIP-OSNAP*))(setq *MIP-OSNAP* nil))
(defun mip-text-draw (txt pnt height rotation justification)
  (mip-var-clear-osnap)
  (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)(progn ;; нулевая высота текста
    (if justification
       (vl-cmdf "_.TEXT" "_J" justification pnt height rotation txt)
       (vl-cmdf "_.TEXT" pnt height rotation txt)))
     (progn  ;; фиксированнная высота
    (if justification
       (vl-cmdf "_.TEXT" "_J" justification pnt rotation txt)
       (vl-cmdf "_.TEXT" pnt rotation txt))))
  (mip-var-restore-osnap)(entlast))
;|=======================================================================================
* Ф-ция mip_TextOnLine_once
* Подписывет текст над линиией без запросов 
* Arguments [Type]:
   txtON = тест над линиией [String]
   Pt_draw = t-запрос точки отрисовки или nil-точка отрисовки (cadr e10N)
      h = высота текста [REAL]
     e10N  - примитив для подписи и точка
             указания. Как в (entsel) '([ENAME] [LIST])
     Rotate - запрашивать угол поворота t - да nil - нет (если Pt_draw t)
     vir    - выравнивение (как в _text) или nil
* Возвращает [Type]:
   список добавленных примитивов (( ep e1) ... (epN e1N))
   ep - имя примитива [ENAME] над чем написан текст
   e1 - имя примитива [ENAME] или текст или Wipeout
   =======================================================================================|; 
(defun mip_TextOnLine_once ( txtON Pt_draw h e1ON Rotate vir / ed e1 txt pt vobj param ang pt1 ug lst_ret ep ugt1 ugt2 *error* sn ort)
(defun *error* (message)(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(while (> (getvar "CMDACTIVE") 0)(command))(princ message)(mip-var-restore-osnap)
  (mapcar '(lambda ( item)(cond ((and (= (type item) 'ENAME)(entget item))(entdel item))
      ((and (= (type item) 'VLA-OBJECT)(vlax-read-enabled-p item))(vl-catch-all-apply 'vla-Delete (list item)))
      (t nil))) *MIP-DELETE-ITEM*)
  (setq *MIP-DELETE-ITEM* nil)(vla-endundomark adoc)(princ))
(if (or txtON (/= (setq txtON (VL-STRING-TRIM " " (getstring "\nВведите значение текста <пропустить>: "))) ""))
  (progn (setq txt txtON)
(setq e1 (car e1ON) pt (cadr e1ON) pt (trans pt 1 0) 
    vobj (vlax-ename->vla-object e1) pt (vlax-curve-getClosestPointTo vobj pt) 
   param (vlax-curve-getParamAtPoint vobj pt) ang (vlax-curve-getFirstDeriv vobj param) 
     pt1 (list (+ (car pt) (car ang)) (+ (cadr pt) (cadr ang))) 
      pt (trans pt 0 1) pt1 (trans pt1 0 1)  ang (angle pt pt1)  ug (rtd ang))
(if (and (> ug 90.0) (<= ug 270.0))(setq ang (+ ang PI) ug (rtd ang)))
(setq ep e1)(if Pt_draw (progn (mip-text-draw txt (cadr e1ON) h ug vir)
  (setq e1 (entlast) ed (entget e1))(setq pt (cadr e1ON))
  (setvar "LASTPOINT" pt)(setq *MIP-DELETE-ITEM* (append *MIP-DELETE-ITEM* (list e1)))
  (princ "\t Точка отрисовки <оставить>:")
  (setq ugt1 (cdr(assoc 50 (entget e1))))(command "_.MOVE" e1 "" (cadr e1ON) pause)
  (setq pt1 (getvar "LASTPOINT"))
  (if (equal pt pt1 0.000001)(progn
      (while (> (getvar "CMDACTIVE") 0)(command ""))(entmod ed)
      (setq *MIP-DELETE-ITEM* (vl-remove e1 *MIP-DELETE-ITEM*)))
     (progn (if Rotate (progn (initget "Y N")
       (setq ugt2 (getkword "\nРазвернуть на 180? [да Y/нет N] <нет>: "))
       (if (= ugt2 "Y")(progn (vla-put-Rotation (vlax-ename->vla-object e1)(+ ugt1 pi))
         (princ "\n Новая точка <не менять>:")(command "_.MOVE" e1 "" pt1 pause)))
           (setq *MIP-DELETE-ITEM* (vl-remove e1 *MIP-DELETE-ITEM*)))))))
  (progn (mip-text-draw txt Pt h ug vir)(setq e1 (entlast))))))
(setq lst_ret (append lst_ret (list (list ep e1)))))
(defun C:M2 ( / adoc *error* selset len Fpt Spt Mpt ang what par) 
(defun *error* (msg)(vla-Regen adoc acActiveViewport)(vla-EndUndoMark adoc)) 
;******************************** 
; Векторное произведение векторов 
;******************************** 
; W1, W2 - вектора 
; Возвращает: вектор нормали к плоскости заданной векторами  в правой системе координат. 
;W1 и W2 не должны лежать на одной прямой). 
(defun 3d_Wnorm (W1 W2)(list (- (* (cadr W1)(caddr W2))(* (caddr W1)(cadr W2))) 
        (- (* (caddr W1)(car W2)) (* (car W1)(caddr W2)))(- (* (car W1)(cadr W2)) (* (cadr W1)(car W2))))) 
(defun group-by-num (lst num / ls ret) 
 (if (= (rem (length lst) num ) 0)(progn (setq ls nil) 
  (repeat (/ (length lst) num)(repeat num (setq ls (cons (car lst) ls) 
  lst (cdr lst)))(setq ret (append ret (list (reverse ls))) ls nil)))) 
  ret) 
(defun getcoors (obj / objname crs)(setq objname (vla-get-ObjectName obj) crs (cond 
 ((= objname "AcDbLine")(list (vlax-curve-getStartPoint obj)(vlax-curve-getEndPoint obj))) 
 ((wcmatch objname "*Polyline")((lambda ( / i lst)(while (<= (setq i (if i (1+ i) 0))(vlax-curve-getEndParam obj)) 
  (setq lst (append lst (list (vlax-curve-getPointAtParam obj i))))) lst))) 
((= objname "AcDbSpline")(group-by-num (vlax-safearray->list(vlax-variant-value(vla-get-fitpoints obj))) 3)) 
(t nil)))) 
(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
(vla-StartUndoMark adoc)(princ "\nВыберите горизонтали ")(setvar "CMDECHO" 0) 
(if (setq selset (ssget "_:L" '((0 . "*LINE"))))(progn 
  (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))) 
  (foreach item lst (setq crs (getcoors item) Fpt (car crs)) 
   (while (setq crs (cdr crs))(setq Spt (car crs)) 
    (setq par (+(* (- (if (cdr crs)(vlax-curve-getParamAtPoint item Spt) 
         (vlax-curve-getEndParam item)) 
      (vlax-curve-getParamAtPoint item Fpt)) 0.5) 
          (vlax-curve-getParamAtPoint item Fpt))) 
     (if (null len)(progn (initget 6)(setq len (getdist "\nРазмер бергштриха <0.5>: ")) 
        (if (null len)(setq len 0.5))(initget 1)(setq Mpt (getpoint 
            (trans (vlax-curve-getPointAtParam item par) 0 1) "\nНаправление бергштриха: ") 
            Mpt (trans Mpt 1 0) Mpt (mapcar '- Mpt Fpt) ang (mapcar '- Spt Fpt) 
            ang (last (3d_Wnorm ang Mpt)))(if (minusp ang)(setq what -)(setq what +)))) 
   (setq ang (what (angle (setq Mpt (vlax-curve-getPointAtParam item par)) 
          (vlax-curve-getPointAtParam item (+ par 0.0001))) (* 0.5 PI))) 
   (vla-AddLine (vla-get-block (vla-get-ActiveLayout adoc)) 
     (vlax-3d-point Mpt)(vlax-3d-point (setq ang (polar Mpt ang len))))
(mip_TextOnLine_once nil ;_Текст nil - запрос "99" - текст 99
                  t
                 1.25     ;_Высота
 (list (vlax-vla-object->ename item)
(polar ang (angle ang Mpt)(+(distance ang Mpt) 0.2))) t "_C")
   (setq Fpt Spt)))(vla-EndUndoMark adoc)))(princ)) 
(princ "\nНаберите в командной строке M2")
VVA вне форума  
 
Автор темы   Непрочитано 10.11.2006, 18:52
#23
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


2VVA Спасибо,только немного не то.Хотелось бы,чтобы Dtext остался со всеми своими функциями,кроме угла поворота текста.Т.е.выбор стиля,высоту и сам текст надо было подтверждать или вводить другое значение.
У меня после загрузки выдает еще
Command: ; error: extra right paren on input
И текст повернут вверх ногами :cry:
Иван вне форума  
 
Непрочитано 13.11.2006, 14:06
#24
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Попробуй еще раз с VVA № 22
1. Стиль установить нужный текущим до вызова команды
2. Высота и значение текста задаются здесь
Код:
[Выделить все]
(mip_TextOnLine_once nil ;_Текст nil - запрос "99" - текст 99 
                  t 
                 1.25     ;_Высота
VVA вне форума  
 
Автор темы   Непрочитано 13.11.2006, 16:52
#25
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от VVA
Попробуй еще раз с VVA № 22
1. Стиль установить нужный текущим до вызова команды
2. Высота и значение текста задаются здесь
Код:
[Выделить все]
(mip_TextOnLine_once nil ;_Текст nil - запрос "99" - текст 99 
                  t 
                 1.25     ;_Высота
Большое человеческое спасибо Прикольный лиспик,только вот у меня иногда бывает вот такая надпись

bad argument type: numberp: nil

Т.е. пару горизонталек подпишет,а на очередной выдает.
Возможно это файл кривой или от 3D сносит его мальца :cry:
Может в курсе,что это ознаечает,чего эму не так?
Иван вне форума  
 
Непрочитано 13.11.2006, 16:58
#26
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Вышли на мыло, погоняю
VVA вне форума  
 
Автор темы   Непрочитано 13.11.2006, 17:33
#27
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от VVA
Вышли на мыло, погоняю
Отмылил
Иван вне форума  
 
Непрочитано 23.11.2006, 09:45
#28
mahony

Пенсионер-проектировщик :-)
 
Регистрация: 23.11.2006
Иркутск
Сообщений: 7


Очень понравилась программка.
А можно её усовершенствовать?
Дополнить рисование бергштрихов почаще и разной длины и толщины?
Надо: допустим большой штрих (например 12 мм) тонкий - на расстоянии (например 5 мм) короткий штрих (треть от длинного 4 мм) толщиной вдвое больше тонкого и т.д...
Конечно длины и расстояния между штрихами желательно спросить у проектировщика...

Тогда чудная была бы программка для отрисовки заготовки откосов.
Если бы она на разных слоях делала бы толстые и короткие и длинные и тонкие - вообще бы круто было бы!
__________________
Всего наилучшего, 73!
mahony вне форума  
 
Автор темы   Непрочитано 23.11.2006, 11:49
#29
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от mahony
Очень понравилась программка.
А можно её усовершенствовать?
Дополнить рисование бергштрихов почаще и разной длины и толщины?
Надо: допустим большой штрих (например 12 мм) тонкий - на расстоянии (например 5 мм) короткий штрих (треть от длинного 4 мм) толщиной вдвое больше тонкого и т.д...
Конечно длины и расстояния между штрихами желательно спросить у проектировщика...

Тогда чудная была бы программка для отрисовки заготовки откосов.
Если бы она на разных слоях делала бы толстые и короткие и длинные и тонкие - вообще бы круто было бы!

Для отрисовки откосов есть ряд афигенных програмулек :wink: Пройдись поиском,откосы в лет рисуют,надо только указать 2 линии и растояние между бергштрихами и откос готов
Иван вне форума  
 
Непрочитано 23.11.2006, 12:09
#30
Завхоз


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


А показать ссылки можно? Потому что то, что я видел, мягко говоря, требовало "доработки" под себя.
Завхоз вне форума  
 
Непрочитано 23.11.2006, 12:59
#31
mahony

Пенсионер-проектировщик :-)
 
Регистрация: 23.11.2006
Иркутск
Сообщений: 7


Цитата:
Сообщение от Иван
Для отрисовки откосов есть ряд афигенных програмулек :wink: Пройдись поиском,откосы в лет рисуют,надо только указать 2 линии и растояние между бергштрихами и откос готов
Есть. Это точно. Но все они рисуют без учёта толщины и длина короткого половина длинной, а у нас принято треть...
Вернее нам так говорили. В ГОСТе - от трети до половины.
И ещё. Для полезного ископаемого необходимо два коротких штриха подряд!
__________________
Всего наилучшего, 73!
mahony вне форума  
 
Автор темы   Непрочитано 23.11.2006, 13:04
#32
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от Завхоз
А показать ссылки можно? Потому что то, что я видел, мягко говоря, требовало "доработки" под себя.
Млин,неужели тяжело набрать в поисковике? Там не так много выдает ссылок,я уже не помню как и где,но прога которая мне приглянулась вроде так называется alxddike.попробуй сразу ее забить в поиск
Иван вне форума  
 
Непрочитано 23.11.2006, 13:12
#33
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996


Цитата:
А показать ссылки можно?
А заглянуть в download?
http://dwg.ru/dnl/60
VVA вне форума  
 
Автор темы   Непрочитано 23.11.2006, 13:12
#34
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


[/quote]Есть. Это точно. Но все они рисуют без учёта толщины и длина короткого половина длинной, а у нас принято треть...[/quote]

Треть?ХЗ,у нас половина А чем Вам половина-то не угодила,зачем порубали ее? :wink:
Иван вне форума  
 
Непрочитано 23.11.2006, 13:17
#35
mahony

Пенсионер-проектировщик :-)
 
Регистрация: 23.11.2006
Иркутск
Сообщений: 7


Цитата:
Сообщение от Иван
Треть?ХЗ,у нас половина А чем Вам половина-то не угодила,зачем порубали ее? :wink:
"А те, кто ГОСТы пишут, они что - такие умные? Нет, просто у них московская прописка..." Вольная цитата из Жванецкого...
__________________
Всего наилучшего, 73!
mahony вне форума  
 
Непрочитано 23.11.2006, 13:23
#36
Завхоз


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


Иван, думаешь меня там не было? Было, даж выгнали.
Что делать тем, у кого 2007 ACAD? Alxdike ведь не запустится. Настройки "коротких" бергштрихов тоже могут быть разными (о чем сказано в соседней ветке). И чо делать?
Как быть, если горизонтали отрисованы не предусмотренными типами примитивов, да еще и в непонятных системах координат (сам тут недавно пробовал сделать для отрезков, легких полилиний, 3д-полилиний и сплайнов одновременно, помер делавши)? Вот так
Завхоз вне форума  
 
Автор темы   Непрочитано 23.11.2006, 13:38
#37
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от Завхоз
Иван, думаешь меня там не было? Было, даж выгнали.
Что делать тем, у кого 2007 ACAD? Alxdike ведь не запустится. Настройки "коротких" бергштрихов тоже могут быть разными (о чем сказано в соседней ветке). И чо делать?
Как быть, если горизонтали отрисованы не предусмотренными типами примитивов, да еще и в непонятных системах координат (сам тут недавно пробовал сделать для отрезков, легких полилиний, 3д-полилиний и сплайнов одновременно, помер делавши)? Вот так
насчет 2007-можно поставить кад 2004 спешл для откосов,к примеру .А насчет остального несовсем понял,причем тут горизонтали,ежели надо отрисоваьт откос,чисто графически,а не расчитать где он будет и как пройдет.
Иван вне форума  
 
Непрочитано 23.11.2006, 13:50
#38
Завхоз


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


Поставить другую версию не всегда возможно, это во-первых. Во-вторых, я говорю именно об отрисовке (расчет отдельная песня).
Завхоз вне форума  
 
Автор темы   Непрочитано 23.11.2006, 14:31
#39
Иван

Музыка,строительство(проектирование)
 
Регистрация: 25.05.2004
Москва
Сообщений: 40
<phrase 1=


Цитата:
Сообщение от Завхоз
Поставить другую версию не всегда возможно, это во-первых. Во-вторых, я говорю именно об отрисовке (расчет отдельная песня).
Твоей ситуации не знает никто акромя тя.Поэтому те решать как выкручиваться.Некоторые вообще считают,что лиспом пользоваться недостойно муЗчины :wink: Так же как и афта с АКПП
Иван вне форума  
 
Непрочитано 24.11.2006, 03:15
#40
KAI

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


На мой взгляд, бергштрихи лучше отрисовывать по линии, которую задает пользователь и которая пересекает горизонтали, имеющие отметки Z, тогда направление бергштрихов будет определено программно, ну а лишние (как сказал ShaggyDoc) несложно и стереть, хотя можно и задать кратность отрисовки бергштрихов, например, через 5 м.
Естественно, бергштрихи должны быть перпендикулярны горизонталям в месте пересечения.
Для одиночных горизонталей направление задается линией бергштрихов, задаваемой пользователем.
Так я и поступил в программе CHELEV.
Хотя ShaggyDoc прав, лучше их отрисовывать блоками, а не линиями, как у меня.
__________________
Лень - великий двигатель прогресса!
KAI вне форума  
 
Непрочитано 24.11.2006, 06:46
#41
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,372


Давайте не сваливать в одну кучу бергштрихи не для откосов и возможность использования такой технологии для откосов. Но, если уж оказалось в одном месте, да в контексте обсуждения программ, то:

1. Бергштрихи можно делать по разному. Зависит от задачи да и от характера рельефа. На ярко выраженном рельефе есть специфика - берг-штрихи должны быть по "хребту". На неявном рельефе - через какое-то охватываемое глазом расстояние. Если слишком часто, например, через 5 м, то горизональ уже можно спутать с обозначением забора. Особенно если это проектная горизонталь, идущая по прямой.

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

Например, имеем (условно) функцию с аргументами

(горизонталь толщина высота_берг-штриха шаг_штрихов)

В меню может быть несколько вариантов:

Код:
[Выделить все]
[Горизонталь тонкая]^C^C^P(defun C:ГОР_0()(горизонталь 0 0.5 10.0))
[Горизонталь толстая]^C^C^P(defun C:ГОР_1()(горизонталь 1.0 1.5 20.0))
[Горизонталь толстая с запросом шага]^C^C^P(defun C:ГОР_2()(горизонталь 1.0 1.5 nil))
В первом варианте - тонкая линия с бергштрихами длиной 0.5 мм на бумаге и с шагом 10 м, во втором - "толстая" с берг-штрихами длиной 1.5 мм на бумаге и шагом 20 м, в третьем - шаг бергштрихов не задан, но после рисования горизонтали программа будет спрашивать точки установки штрихов (это подойдет, когда их мало, но надо именно в заданных местах), а штрихи будут рисоваться правильной длины и "перпендикулярно" линии.

Даже "не шибко смышленая тетка" может наплодить нужное ей количество вариантов в меню.

2. С откосами сложнее. Есть много вариантов, в том числе специфичных для конкретной отрасли. И в стандартной топографии есть откосы укрепленные и неукрепленные, земляные, с плитами, с подпорными стенками. А также для мелкомасштабных планов, где не делаются длинные и короткие штрихи, а длина штриха условна и не отражает реальную высоту.

Но и тут желателен подобный подход - функция с аргументами, доступными для изменения пользователем. Если вопрос, например, в длине короткого штриха, то ее надо задать в виде одного из аргументов, например 0.5 - половина склона, 0.33 - треть, а если nil - то 2 мм на бумаге по топографическому стандарту.
ShaggyDoc вне форума  
 
Непрочитано 26.04.2008, 05:15
#42
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Подскажите пожалуйста, как сделать так, чтоб выбранная полилиния делилась на равные куски заданной длины (например 200мм) штрихами, но не совсем берг-, а как бы двойными берг-)), то есть чтоб этот штришок пересекал полилинию в своем центре, был перпендикулярен полилинии и был длиной 4 мм и со свойствами линии по слою.....Облазил все что мог, пытался какие-то лиспы менять, но плоховат я еще в этом деле....
skkkk вне форума  
 
Непрочитано 26.04.2008, 14:26
#43
Кулик Алексей aka kpblc
Moderator

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


Либо _.divide с использованием блоков; либо тип линии создавай свой. Первый вариант, наверное, более удобен будет.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 03.06.2008, 04:46
#44
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


По #42: Больше всего подошла команда _measure с использованием блока, созданного перетаскиванием отрезка в 4 мм правой кнопкой мыши за центр, выбором функции <Вставить как блок>, выбором интервала <200> и ориентировкой блока по полилинии (запросы при выполнении команды). А еще лучше оказался макрос
^C^C_measure;\_b;piket;;200;_xplode;_p;;;;
он сразу разбивает полилинию блоком с именем piket через 200мм и взрывает этот блок (если созданный по описанному выше алгоритму блок назвать piket, он вставится на свои места), причем разметка начнется с того конца полилинии, ближе к которому кликнуть при запросе программы <Выберите объект для разметки>. Очень полезно для геодезистов при расстановке пикетов через определенное расстояние. Если кто что не понял - могу пояснить более подробно, пишите сюда.
skkkk вне форума  
 
Непрочитано 23.10.2014, 00:06
#45
Мих


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


^C^C_measure;\_b;piket;;200;_xplode;_p;;;; -- а как поправить чтоб сразу кучу полилиний разметить?
Мих вне форума  
 
Непрочитано 23.10.2014, 06:41
#46
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Только лиспом. Но при таком варианте с какой стороны полилинии начинать разметку? Всегда с начала полилинии? Макросом размечается с той стороны, куда кликнуть.
skkkk вне форума  
 
Непрочитано 23.10.2014, 15:09
#47
Kirill_Ja


 
Регистрация: 28.07.2008
Мурманск
Сообщений: 208
<phrase 1=


По поводу бергштрихов и пикетов можно не изобретать велосипеда и пользоваться Civil 3D. Там вся работа с поверхностями и трассами очень классно реализована.
Для расстановки бергшрихов можно использовать метку горизонтали из отрезка нужной длины.
Будет не только считаться и рисоваться автоматом и в нужном направлении, но и динамически обновляться при изменении поверхности (добавление/удаление съемочных пикетов, перестановка ребер TIN)
Про трассы и профиля не буду говорить даже. Экономия времени бешеная просто.

Offtop: Хотя это немного и не про программирование
__________________
Мне не нужно сделать за меня. Если я что-то ищу, то пути решения.
Kirill_Ja вне форума  
 
Непрочитано 23.10.2014, 15:35
#48
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,680


Offtop: Kirill_Ja, во-первых, Civil есть не у всех, и не у всех когда-то будет. Во-вторых, в нем работать еще нужно научиться, а если человеку нужны только бергштрихи, то окупится этот цивил с обучением еще ой как не скоро. В-третьих, попробуй-ка согласуй у нас то, что выдаст цивил - не всегда удастся, придираются, тут мол профиль не по ГОСТ, а тут вот так, а тут эдак. Придется переделывать/перенастраивать, проще дёрнуть с форума маленький лиспик и всего делов .
Я думаю, так рассуждает добрая часть из работающих в AutoCAD, и многих можно понять.
skkkk вне форума  
 
Непрочитано 23.10.2014, 16:54
1 | #49
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,182


Поставить звездочку в начале:
Код:
[Выделить все]
*^C^C_measure;\_b;piket;;200;_xplode;_p;;;;
Не совсем "сразу кучу полилиний", но все же не вызывать макрос каждый раз
kp+ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен лиспик по черчению бергштрихов(не для откосов)