[void2005]

Необходим лисп объекта (см. вложения) в котором всего лишь одна несчастная переменная В (от 400 до 1000), и 2 точки вставки блоков (блоки разные, ссылки на них выставлю сам позже) вызов лиспа с команды (допустим kass) не знаю с чего начать, за что хвататься? Поизучал литературку, посмотрел примеры, ужаснулся...ПОМОЖИТЕ ХОТЬ НАЧАТЬ... дальше будет легче...

[Олег (jr.)]

Пробуем

Код:

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

(defun C:demo(/ acsp bname cnt coords elist en ent )
(if (setq ent (entsel "\nSelect vertical polyline >"))
  (progn
    (setq en (car ent))
    (setq elist (entget en))
    (if
      (eq "LWPOLYLINE" (cdr (assoc 0 elist)))
       (progn
	 (setq coords (vl-remove-if
			'not
			(mapcar	(function (lambda (x)
					    (if	(= 10 (car x))
					      (trans (cdr x) 0 1))))
				elist)))
	 (setq coords (vl-sort coords
			       (function (lambda (a b) (< (cadr a) (cadr b))))))

	 (if (and coords
		  (eq (length coords) 2))
	   (progn
	     (vl-load-com)
	     (setq acsp	(vla-get-block
			  (vla-get-activelayout
			    (vla-get-activedocument
			      (vlax-get-acad-object)))))
	     (setq cnt 0)

	     (foreach point  coords

	       (setq bname (getstring t
				      (if (zerop cnt)
					"\nНижний блок : "
					"\nВерхний блок : ")))
	       (vlax-invoke-method
		 acsp
		 'InsertBlock
		 (vlax-3d-point
		   point)
		 bname
		 1
		 1
		 1
		 0)
	       (setq cnt (1+ cnt))
	       )
	     )
	     (alert
	       "Error\nMust be a LWPOLYLINE with two coodinates only")
	     )
	 )
	   (alert
	     "Error\nUnsupported polyline type in this program\n Must be a LWPOLYLINE")
	   )

       )
    (alert "Nothing selected")
    )
  

   (princ)
   )
   (C:demo)

[Дима_]

А что насчет динамических блоков?

[void2005]

необходимо чтоб лисп-програмка строила фигуру как на эскизе (см. приложение) с задаванием переменной В!Лисп Олег (jr.) очень пригодится!!

[Олег (jr.)]

Сообщение от void2005 необходимо чтоб лисп-програмка строила фигуру как на эскизе (см. приложение) с задаванием переменной В!Лисп Олег (jr.) очень пригодится!!

Ты не поверишь но это было первое что я узнал об Автолипе
http://aco.ifmo.ru/~nadinet/html/lectures/lsp_3.html
бери за основу

[Дима_]

Сообщение от Олег (jr.) http://aco.ifmo.ru/~nadinet/html/lectures/lsp_3.html бери за основу

Я не претендую на истину - но мне кажется, что подобный пример только портит представление об Автолиспе. ИХМО лучше разбирать реальные примеры (Ваш то пример на "ссылочный" не больно похож), а не забивать мозг ненужным мусором.

[void2005]

Сообщение от Олег (jr.) Ты не поверишь но это было первое что я узнал об Автолипе http://aco.ifmo.ru/~nadinet/html/lectures/lsp_3.html бери за основу

Ну помогите хоть начать на моем примере..!

[gomer]

Сообщение от Олег (jr.) Ты не поверишь но это было первое что я узнал об Автолипе http://aco.ifmo.ru/~nadinet/html/lectures/lsp_3.html

Таких бы преподов да на рынок... там им и место

[Олег (jr.)]

Сообщение от void2005 Ну помогите хоть начать на моем примере..!

Посмотри код, добавил кое-какие пояснения
Писал специально как можно проще чтобы было легче понять
Для начала пиши так же каждое выражение отдельной строкой
потом научишься задавать значения одним блоком

Успехов,

Код:

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

(defun C:DETAL(/ dia en hgt1 hgt2 hgt3 op p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 pd1 thk wid1 wid2)

(setq p0 (getpoint "\nНижняя правая точка: "))
  (initget 6);<-- запрет ввода нуля и отрицательного значения, возможность ввода по умолчанию(по Enter)
(setq thk (getdist "\n Толщина детали <4>: "))
(if (not thk)(setq thk 4.0))

(initget 6)
(setq wid1 (getdist "\n Ширина снаружи внизу <20>: "))
(if (not wid1)(setq wid1 20.0))
  
(setq hgt1 nil)
  ;;;Пример  ввода значений строго в дипазоне 400-1000
  (while
;;;начало блока условий
    (not
      (and
	(or
	  (initget 7);<-- запрет ввода нуля, отрицательного значения и о ввода по умолчанию (по Enter)
	  (setq hgt1 (getdist "\n Высота слева (400-1000): ")))
	(>= 1000 hgt1 400))
      );<-- _конец блока условий ввода
     (alert "значение строго в дипазоне 400-1000")
     )
(initget 6)
(setq wid2 (getdist "\n Ширина снаружи вверху <39>: "))
(if (not wid2)(setq wid2 20.0))
  
(initget 6)
(setq hgt2 (getdist "\n Высота изгиба изнутри <7.8>: "))
(if (not hgt2)(setq hgt2 7.8))
  
(initget 6)
(setq dia (getdist "\n даметр отверстия <4.1>: "))
(if (not dia)(setq dia 4.1))
  
(initget 6)
(setq hgt3 (getdist "\n Высота оставшейся части <8>: "))
(if (not hgt3)(setq hgt3 8))

(setq p1 (list (- (car p0) wid1)(cadr p0)))

(setq p2 (list (car p1)(+ (cadr p1) hgt1)))
      
(setq p3 (list (+ (car p1)(- wid2 thk))(cadr p2)))
       
(setq p4 (list (car p3)(+ (cadr p3) hgt2)))
      
(setq p5 (list (+ (car p4) thk) (cadr p4)))

(setq p6 (list (car p5)(- (cadr p3) thk)))

(setq p7 (list (+ (car p2)thk) (cadr p6) ))

(setq p8 (list (car p7) (+ (cadr p0) thk)))

(setq p9 (list (car p0) (cadr p8) ))
  
(setq op (list (/ (+ (car p2)(car p7)) 2.)(/ (+ (cadr p2)(cadr p7)) 2.)));<--точка указания области штриховки

(setq pd1 (list (- (car p2) 15)(cadr p2)));<-- точка позиционирования размерной линии (только для одного размера-остальные сам)
  
(command "_zoom" "_W" p1 p5);<-- для создания штриховки командой обязательно чтобы границы ее были полностью видны на экране

(command "_pline" "_non" p0 "_non"  p1 "_non" p2 "_non"  p3 "_non" p4 "_non"  p5 "_non"  p6 "_non"  p7 "_non" p8 "_non"  p9 "_non"   "_CL");<-- "_non" для отключения привязок, "_CL"-замкнутая 

(setq en (entlast))
      
(command "-hatch" "_P" "ANSI37" "20" "0" "_A" "_B" "N" en "" "" "_non" op "")
      
(command "_dimlinear" p1 p2 pd1);<-- размер слева

(setq p1  (list (car p4)(+ (cadr p4) dia)))
  
  
(setq p2 (list  (+ (car p1)thk) (+ (cadr p1) hgt3)))
  
(setq op (list (/ (+ (car p1)(cadr p1)) 2.)(/ (+ (car p2)(cadr p2)) 2.)));<--точка указания области штриховки
  
(command "_zoom" "_W" p1 p5)
  
(command "_rectang" p1 p2)

  (setq en (entlast))

  (command "_zoom" "_W" p1 p2);<-- для создания штриховки командой обязательно чтобы границы ее были полностью видны на экране

  (command "_zoom" ".9X" );<-- масштаб зуммирования 0.9


 (command "-hatch" "_P" "ANSI37" "20" "0.0" "_S" en "" "" "_non" op "")

  (command "_zoom" "_W" p0 p1)

 (command "_zoom" ".7X" )

(princ)
      
)
(prompt "\n\t\t   ***   *Для старта ввести DETAL*   ***")

(prin1)

[void2005]

Класс!!! маленько не то что хотелось, но мелочи постaраюсь додумать сам. Вот только со вставкой блоков не понятно..?

[Олег (jr.)]

Сообщение от void2005 Класс!!! маленько не то что хотелось, но мелочи постaраюсь додумать сам. Вот только со вставкой блоков не понятно..?

Потому что ты не сказал какие блоки?
С атрибутами или без?
Команда для вставки одна, но далее могут быть дополнения
в смысле изменения значений атрибутов

[void2005]

Сообщение от Олег (jr.) Потому что ты не сказал какие блоки? С атрибутами или без? Команда для вставки одна, но далее могут быть дополнения в смысле изменения значений атрибутов

пытаюсь воткнуть блок в точку р8, не встает! Где ошибка?
(command "_.insert" "C:/macro/GORblocks/salazniz.dwg" "p8" "1" "1" "0")

[Олег (jr.)]

Сообщение от void2005 пытаюсь воткнуть блок в точку р8, не встает! Где ошибка? (command "_.insert" "C:/macro/GORblocks/salazniz.dwg" "p8" "1" "1" "0")

Во-первых p8 это переменная а не строка
Во-вторых синтаксис расписан в справке:

Код:

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

(command "_.-insert" "имя блока которое ты будешь использовать для вставляемого из чертежа=C:/macro/GORblocks/salazniz.dwg" p8 "1.0" "1.0" "0.0")

т.е. в твоем случае:

В третьих перед вставкой блока неплохо заблокировать окно атрибутов:

Код:

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

(setvar 'attreq 0)

а после вставки блока вернуть его нормальный статус

Код:

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

(setvar 'attreq 1)

Неплохо проверять наличие блока в базе данных перед вставкой и после нее с помощью функции tblsearch
и уже после прописываить вызов команды insert:

Код:

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

(if (not (tblsearch "blocks" "salazniz"))
  (progn
  (princ "\nБлок вставляется из другого документа")
(command "_.insert" "salazniz=C:/macro/GORblocks/salazniz.dwg" p8 "1" "1" "0");<--если блока salazniz пока еще не существует
  )
  (progn
    (princ "\nБлок уже в документе вставляем его из коллекции блоков данного документа")
(command "_.insert" "salazniz=" p8 "1" "1" "0");<--когда блок уже появился в списке
)
  )

Вообще-то проверка и откат должны быть более совершенными (см. на форуме или в Google: error handling AutoLisp)
Но по минимуму этого достаточно

[void2005]

Вроде работает

Код:

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

 
 
(defun C:kassgor(/ dia en hgt1 hgt2 hgt3 op p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 pd1 thk wid1 wid2)
 
(setq p0 (getpoint "\nТочка вставки: "))
(initget 6);<-- запрет ввода нуля и отрицательного значения, возможность ввода по умолчанию(по Enter)
(setq thk (getdist "\n Толщина кассеты <4>: "))
(if (not thk)(setq thk 4.0))
 
(initget 6)
;(setq wid1 (getdist "\n Ширина снаружи внизу <29>: "))
(if (not wid1)(setq wid1 29.0))
 
(setq hgt1 nil)
;;;Пример ввода значений строго в дипазоне 200-2000
(while
;;;начало блока условий
(not
(and
(or
(initget 7);<-- запрет ввода нуля, отрицательного значения и о ввода по умолчанию (по Enter)
(setq hgt1 (getdist "\n Высота кассеты (200-2000): ")))
(>= 2000 hgt1 200))
);<-- _конец блока условий ввода
(alert "значение строго в дипазоне 200-2000")
)
(initget 6)
;(setq wid2 (getdist "\n Ширина снаружи вверху <39>: "))
(if (not wid2)(setq wid2 39.0))
 
(initget 6)
;(setq hgt2 (getdist "\n Высота изгиба изнутри <7.8>: "))
(if (not hgt2)(setq hgt2 7.8))
 
(initget 6)
;(setq dia (getdist "\n даметр отверстия <4.35>: "))
(if (not dia)(setq dia 4.35))
 
(initget 6)
;(setq hgt3 (getdist "\n Высота оставшейся части <8>: "))
(if (not hgt3)(setq hgt3 7.75))
 
(setq p1 (list (- (car p0) wid1)(cadr p0)))
 
(setq p2 (list (car p1)(+ (cadr p1) hgt1)))
 
(setq p3 (list (+ (car p1)(- wid2 thk))(cadr p2)))
 
(setq p4 (list (car p3)(+ (cadr p3) hgt2)))
 
(setq p5 (list (+ (car p4) thk) (cadr p4)))
 
(setq p6 (list (car p5)(- (cadr p3) thk)))
 
(setq p7 (list (+ (car p2)thk) (cadr p6) ))
 
(setq p8 (list (car p7) (+ (cadr p0) thk)))
 
(setq p9 (list (car p0) (cadr p8) ))
 
(setq op (list (/ (+ (car p2)(car p7)) 2.)(/ (+ (cadr p2)(cadr p7)) 2.)));<--точка указания области штриховки
 
(setq pd1 (list (- (car p2) 15)(cadr p2)));<-- точка позиционирования размерной линии (только для одного размера-остальные сам)
 
(command "_zoom" "_W" p1 p5);<-- для создания штриховки командой обязательно чтобы границы ее были полностью видны на экране
 
(command "_pline" "_non" p0 "_non" p1 "_non" p2 "_non" p3 "_non" p4 "_non" p5 "_non" p6 "_non" p7 "_non" p8 "_non" p9 "_non" "_CL");<-- "_non" для отключения привязок, "_CL"-замкнутая 
 
(setq en (entlast))
 
(command "_-layer" "_n" "shtrich" "_c" "3" "shtrich" "_s" "shtrich" "")
 
(command "-hatch" "_P" "ANSI37" "10" "0" "_A" "_B" "N" en "" "" "_non" op "")
 
(command "_-layer" "_s" "0" "") 
 
;(command "_dimlinear" p1 p2 pd1);<-- размер слева
 
(setq p1 (list (car p4)(+ (cadr p4) dia)))
 
 
(setq p2 (list (+ (car p1)thk) (+ (cadr p1) hgt3)))
 
(setq op (list (/ (+ (car p1)(cadr p1)) 2.)(/ (+ (car p2)(cadr p2)) 2.)));<--точка указания области штриховки
 
(command "_zoom" "_W" p1 p5)
 
(command "_rectang" p1 p2)
 
(setq en (entlast))
 
(command "_zoom" "_W" p1 p2);<-- для создания штриховки командой обязательно чтобы границы ее были полностью видны на экране
 
(command "_zoom" ".9X" );<-- масштаб зуммирования 0.9
 
(command "_-layer" "_n" "shtrich" "_c" "3" "shtrich" "_s" "shtrich" "")
 
(command "-hatch" "_P" "ANSI37" "10" "0.0" "_S" en "" "" "_non" op "")
 
(command "_zoom" "_W" p0 p1)
 
(command "_zoom" ".7X" )
 
(command "_-layer" "_s" "0" "")
 
(command "_-Insert" "*C:/macro/GORblocks/salazniz.dwg" "_non" p8 "1" "0")
 
(command "_-Insert" "*C:/macro/GORblocks/salazverh.dwg" "_non" p7 "1" "0")
 
(princ)
 
)
(prompt "\n\t\t *** *Для старта ввести kassgor* ***")
 
(prin1)

Вопрос такой, почемуто блок не всегда встает в масштабе, бывает выскакивает больше в 2.5раза

[Лиспер]

void2005, ты хоть тэг закрой... Читать невозможно!

Сообщение от void2005 почемуто блок не всегда встает в масштабе, бывает васкакивает больше в 2.5раза

Проверяй единицы блока.

[Олег (jr.)]

Выделяй код в окне сообщений и потом нажми кнопку # в меню окна сообщений!
Добавь в программу локальную функцию:

Код:

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

;set block scale uniformly to given value
(defun put-scale-all  (blk scale)
  (and (eq (type blk) 'ENAME)
       (setq elist (entget blk))
       (eq "INSERT"(cdr (assoc 0 elist)))
	   (setq elist (subst (cons 41 scale) (assoc 41 elist) elist)
		 elist (subst (cons 42 scale) (assoc 42 elist) elist)
		 elist (subst (cons 43 scale) (assoc 43 elist) elist)
		 )
	   (entmod elist)
	   (entupd blk)
	   )
       )

и сразу после вставки блока добавляй такую строку:

Код:

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

(put-scale-all (entlast) 1.0)

[void2005]

Огромное спасибо ВСЕМ за содействие!!!