AutoLISP. Не строит правильно по проге

MGK · 24.12.2011, 15:52

Здравствуйте. Возникла такая проблема. Есть программа в AutoLisp по ней должна быть построена фигура, но почему-то контуры строит правильно, а вот так необходимые круги по построению строит по непонятной линии:
[IMG]http://s53.***********/i140/1112/4c/fc388d990088t.jpg[/IMG]

Сам код программы:

Код:

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

(defun q ()
  (setq	p   (getpoint "p - ?")
	a   (getreal "a - ?")
	x   (car p)
	y   (cadr p)
	p1  (list x y)
	p2  (list (- x a) y)
	p3  (list (- x (* 2 a)) (+ y a))
	p4  (list (- x (* 2 a)) (+ y (* 3.5 a)))
	p5  (list x (+ y (* 3.5 a)))
	p6  (list x (+ y (* 4 a)))
	p7  (list x (- y (/ a 2)))
	p8  (list (- x (* 1.7 a)) (+ y (* 3.2 a)))
	p9  (list (- x (* 1.7 a)) (+ y (* 2.7 a)))
	p10 (list (- x (* 1.7 a)) (+ y (* 2.2 a)))
	p11 (list (- x (* 1.7 a)) (+ y (* 1.7 a)))
	p12 (list (- x (* 1.7 a)) (+ y a))
	p13 (list (- x (* 0.45 a)) (+ y (* 0.3 a)))
	p14 (list (- x a) (+ y a))
	p16 (list (- x (* 1.7 a)) (+ y (* 3.4 a)))
	p17 (list (- x (* 1.7 a)) (+ y (* 3 a)))
	p18 (list (- x (* 1.9 a)) (+ y (* 3.2 a)))
	p19 (list (- x (* 1.5 a)) (+ y (* 3.2 a)))
	p20 (list (- x (* 1.9 a)) (+ y (* 3.4 a)))
	p21 (list (- x (* 1.5 a)) (+ y (* 3 a)))
  )
  (command "pline" p1 "w" 0.1 0.1 p2 "a" p3 "l" p4 p5 "")
  (command "circle" p8 (/ a 8) "")
  (command "layer" "n" "osi" "l" "center" "osi" "s" "osi" "")
  (command "line" p6 p7	"" "line" p16 p17 "" "line" p18	p19 "")
  (command "layer" "s" "0" "")
  (command "copy" "c" p20 p21 "" p8 p9 "")
  (command "copy" "c" p20 p21 "" p8 p10 "")
  (command "copy" "c" p20 p21 "" p8 p11 "")
  (command "copy" "c" p20 p21 "" p8 p12 "")
  (command "copy" "c" p20 p21 "" p8 p13 "")
  (setq	m 1
	d (/ PI 6)
  )
  (repeat 3
    (setq p15 (polar p14 (+ PI (* m d)) (* 0.7 a))
	  m   (+ m 1)
    )
    (command "copy" "c" p20 p21 "" p8 p15 "")
  )
(command "mirror" "c" p7 p4 "" p6 p7 "")
)

Помогите исправить ошибку.

P.S. Автокад 2004 + надо перевернуть на 180 сам рисунок. Сделать никак не могу - дома только 09 кад, а в прогу придется перебивать тогда(

Кулик Алексей aka kpblc · 24.12.2011, 16:28

1. Никто не мешает прикреплять рисунки к постам.
2. В локализованной версии лисп работать не будет.
3. Привязки снимать кто должен?

MGK · 24.12.2011, 16:40

1. Рисунок есть.
2. Он там работает! В универе только на нем и работаем.
3. Вот при снятии привязок, он может только один круг нарисовать, может нарисовать только половину контура, может по другой линии расположить круги, но вдоль линии контура ни в какую...

Oliver_88 · 25.12.2011, 12:55

Так должно рисовать нормально

Код:

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

 
  (defun q ( / ssl1 ssl2 lst)
  (setq	p   (getpoint "p - ?")
	a   (getreal "a - ?")
	x   (car p)
	y   (cadr p)
	p1  (list x y)
	p2  (list (- x a) y)
	p3  (list (- x (* 2 a)) (+ y a))
	p4  (list (- x (* 2 a)) (+ y (* 3.5 a)))
	p_2  (list (+ x a) y)
	p_3  (list (+ x (* 2 a)) (+ y a))
	p_4  (list (+ x (* 2 a)) (+ y (* 3.5 a)))
	p5  (list x (+ y (* 3.5 a)))
	p6  (list x (+ y (* 4 a)))
	p7  (list x (- y (/ a 2)))
	p8  (list (- x (* 1.7 a)) (+ y (* 3.2 a)))
	p9  (list (- x (* 1.7 a)) (+ y (* 2.7 a)))
	p10 (list (- x (* 1.7 a)) (+ y (* 2.2 a)))
	p11 (list (- x (* 1.7 a)) (+ y (* 1.7 a)))
	p12 (list (- x (* 1.7 a)) (+ y a))
	p13 (list (- x (* 0.45 a)) (+ y (* 0.3 a)))
	p14 (list (- x a) (+ y a))
	p16 (list (- x (* 1.7 a)) (+ y (* 3.4 a)))
	p17 (list (- x (* 1.7 a)) (+ y (* 3 a)))
	p18 (list (- x (* 1.9 a)) (+ y (* 3.2 a)))
	p19 (list (- x (* 1.5 a)) (+ y (* 3.2 a)))
	p20 (list (- x (* 1.9 a)) (+ y (* 3.4 a)))
	p21 (list (- x (* 1.5 a)) (+ y (* 3 a)))
	)
  (entmake
    '(
      (0 . "LTYPE")
      (100 . "AcDbSymbolTableRecord")
      (100 . "AcDbLinetypeTableRecord")
      (2 . "center")
      (70 . 0)
      (3 . "ISO ш/пункт. __ . __ . __ . __ . __ . __ . __ .")
      (72 . 65)
      (73 . 4)
      (40 . 18.0)
      (49 . 12.0)
      (74 . 0)
      (49 . -3.0)
      (74 . 0)
      (49 . 0.0)
      (74 . 0)
      (49 . -3.0)
      (74 . 0)
      )
    )
  (entmake
    '(
      (0 . "LAYER")
      (100 . "AcDbSymbolTableRecord")
      (100 . "AcDbLayerTableRecord")
      (2 . "osi")
      (70 . 0)
      (62 . 7)
      (6 . "center")
      (290 . 1)
      (370 . -3)
      )
    )
  (setq ssl1 (ssadd))
  (setq ssl2 (ssadd))
  (entmake
    (list
      '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(67 . 0)
      '(410 . "Model")
      '(8 . "0")
      '(100 . "AcDbPolyline")
      '(90 . 8)
      '(70 . 0)
      '(43 . 0.1)
      '(38 . 0.0)
      '(39 . 0.0)
      (cons 10 p2)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . -0.414214)
      (cons 10 p3)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . 0.0)
      (cons 10 p4)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . 0.0)
      (cons 10 p_4)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . 0.0)
      (cons 10 p_3)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . -0.414214)
      (cons 10 p_2)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . 0.0)
      (cons 10 p2)
      (cons 40 0.1)
      (cons 41 0.1)
      '(42 . 0.0)
      '(210 0.0 0.0 1.0)
      )
    )
  (ssadd (entlast) ssl1)
  (entmake
    (list
      '(0 . "LINE")
      '(100 . "AcDbEntity")
      '(67 . 0)
      '(410 . "Model")
      '(8 . "osi")
      (cons 48 (/ a 33))
      '(100 . "AcDbLine")
      (cons 10 p6)
      (cons 11 p7)
      '(210 0.0 0.0 1.0)
      )
    )
  (ssadd (entlast) ssl1)
  (mapcar
    (function
      (lambda (s)
	(entmake
	  (list
	    '(0 . "CIRCLE")
	    '(100 . "AcDbEntity")
	    '(67 . 0)
	    '(410 . "Model")
	    '(8 . "0")
	    '(100 . "AcDbCircle")
	    (cons 10 (car s))
	    (cons 40  (/ a 8))
	    '(210 0.0 0.0 1.0)
	    )
	  )
	(ssadd (entlast) ssl2)
	(entmake
	  (list
	    '(0 . "LINE")
	    '(100 . "AcDbEntity")
	    '(67 . 0)
	    '(410 . "Model")
	    '(8 . "osi")
	    (cons 48 (/ a 114))
	    '(100 . "AcDbLine")
	    (cons 10 (caadr s))
	    (cons 11 (cadadr s))
	    '(210 0.0 0.0 1.0)
	    )
	  )
	(ssadd (entlast) ssl2)
	(entmake
	  (list
	    '(0 . "LINE")
	    '(100 . "AcDbEntity")
	    '(67 . 0)
	    '(410 . "Model")
	    '(8 . "osi")
	    (cons 48 (/ a 114))
	    '(100 . "AcDbLine")
	    (cons 10 (caaddr s))
	    (cons 11 (cadr (last s)))
	    '(210 0.0 0.0 1.0)
	    )
	  )
	(ssadd (entlast) ssl2)
	)
      )
    (list
      (list
	p8
	(list p16 p17)
	(list p18 p19)
	)
      (list
	p9
	(list
	  (polar p16 (angle p8 p9)
		 (distance p8 p9))
	  (polar p17 (angle p8 p9)
		 (distance p8 p9))
	  
	  )
	(list
	  (polar p18 (angle p8 p9)
		 (distance p8 p9))
	  (polar p19 (angle p8 p9)
		 (distance p8 p9))
	  
	  )
	)
      (list
	p10
	(list
	  (polar p16 (angle p8 p10)
		 (distance p8 p10))
	  (polar p17 (angle p8 p10)
		 (distance p8 p10))
	  
	  )
	(list
	  (polar p18 (angle p8 p10)
		 (distance p8 p10))
	  (polar p19 (angle p8 p10)
		 (distance p8 p10))
	  
	  )
	)
      (list
	p11
	(list
	  (polar p16 (angle p8 p11)
		 (distance p8 p11))
	  (polar p17 (angle p8 p11)
		 (distance p8 p11))
	  
	  )
	(list
	  (polar p18 (angle p8 p11)
		 (distance p8 p11))
	  (polar p19 (angle p8 p11)
		 (distance p8 p11))
	  
	  )
	)
      (list
	p12
	(list
	  (polar p16 (angle p8 p12)
		 (distance p8 p12))
	  (polar p17 (angle p8 p12)
		 (distance p8 p12))
	  
	  )
	(list
	  (polar p18 (angle p8 p12)
		 (distance p8 p12))
	  (polar p19 (angle p8 p12)
		 (distance p8 p12))
	  
	  )
	)
      (list
	p13
	(list
	  (polar p16 (angle p8 p13)
		 (distance p8 p13))
	  (polar p17 (angle p8 p13)
		 (distance p8 p13))
	  
	  )
	(list
	  (polar p18 (angle p8 p13)
		 (distance p8 p13))
	  (polar p19 (angle p8 p13)
		 (distance p8 p13))
	  
	  )
	)
      (list
	p13
	(list
	  (polar p16 (angle p8 p13)
		 (distance p8 p13))
	  (polar p17 (angle p8 p13)
		 (distance p8 p13))
	  
	  )
	(list
	  (polar p18 (angle p8 p13)
		 (distance p8 p13))
	  (polar p19 (angle p8 p13)
		 (distance p8 p13))
	  
	  )
	)
      (list
	(setq p15 (polar p14 (+ pi (/ pi 6)) (* 0.7 a)))
	(list
	  (polar p16 (angle p8 p15)
		 (distance p8 p15))
	  (polar p17 (angle p8 p15)
		 (distance p8 p15))
	  
	  )
	(list
	  (polar p18 (angle p8 p15)
		 (distance p8 p15))
	  (polar p19 (angle p8 p15)
		 (distance p8 p15))
	  
	  )
	)
      (list
	(setq p23 (polar p14 (+ pi (/ pi 3)) (* 0.7 a)))
	(list
	  (polar p16 (angle p8 p23)
		 (distance p8 p23))
	  (polar p17 (angle p8 p23)
		 (distance p8 p23))
	  
	  )
	(list
	  (polar p18 (angle p8 p23)
		 (distance p8 p23))
	  (polar p19 (angle p8 p23)
		 (distance p8 p23))
	  
	  )
	)
      (list
	(setq p22 (polar p14 (+ pi (/ pi 2)) (* 0.7 a)))
	(list
	  (polar p16 (angle p8 p22)
		 (distance p8 p22))
	  (polar p17 (angle p8 p22)
		 (distance p8 p22))
	  
	  )
	(list
	  (polar p18 (angle p8 p22)
		 (distance p8 p22))
	  (polar p19 (angle p8 p22)
		 (distance p8 p22))
	  
	  )
	)
      )
    )
  (mapcar
    (function
      (lambda (g /  obj)
	(setq obj (entget (cadr g)))
	(cond
	  (
	   (equal "LINE" (cdr (assoc 0 obj)))
	   (entmake
	       (vl-remove-if
		 (function
		   (lambda(gh)
		     (member (car gh) '(-1 330 5)
			     )
		     )
		   )
		 (subst
		   (cons 10 (polar (cdr (assoc 10 obj))
				   0
				   (* 2 (- x (cadr (assoc 10 obj))))
				   )
			 )
		   (assoc 10 obj)
		   (subst
		     (cons 11 (polar (cdr (assoc 11 obj))
				   0
				   (* 2 (- x (cadr (assoc 11 obj))))
				     )
			   )
		     (assoc 11 obj)
		     obj
		     )
		   )
		 )
	     )
	   (ssadd (entlast) ssl1)
	   )
	  (
	   (equal "CIRCLE" (cdr (assoc 0 obj)))
	   (entmake
	       (vl-remove-if
		 (function
		   (lambda(gd)
		     (member (car gd) '(-1 330 5)
			     )
		     )
		   )
		 (subst
		   (cons 10 (polar (cdr (assoc 10 obj))
				   0
				   (* 2 (- x (cadr (assoc 10 obj))))
				   )
			 )
		   (assoc 10 obj)
		   obj
		   )
		 )
	     )
	   (ssadd (entlast) ssl1)
	   )
	  )
	)
      )
    (setq lst (ssnamex ssl2))
    )
  (mapcar
    (function
      (lambda (w)
	(ssdel (cadr w) ssl2)
	(ssadd (cadr w) ssl1)
	)
      )
    lst
    )
  (mapcar
    (function
      (lambda (gl /  obj)
	(setq obj (entget (cadr gl)))
	(cond
	  (
	   (equal "LINE" (cdr (assoc 0 obj)))
	   (entmake
	       (vl-remove-if
		 (function
		   (lambda(gt)
		     (member (car gt) '(-1 330 5)
			     )
		     )
		   )
		 (subst
		   (cons 10 (polar (cdr (assoc 10 obj))
				   (/ pi 2)
				   (* 2 (- y (caddr (assoc 10 obj))))
				   )
			 )
		   (assoc 10 obj)
		   (subst
		     (cons 11 (polar (cdr (assoc 11 obj))
				     (/ pi 2)
				     (* 2 (- y (caddr (assoc 11 obj))))
				     )
			   )
		     (assoc 11 obj)
		     obj
		     )
		   )
		 )
	     )
	   )
	  (
	   (equal "CIRCLE" (cdr (assoc 0 obj)))
	   (entmake
	       (vl-remove-if
		 (function
		   (lambda(td)
		     (member (car td) '(-1 330 5)
			     )
		     )
		   )
		 (subst
		   (cons 10 (polar (cdr (assoc 10 obj))
				   (/ pi 2)
				   (* 2 (- y (caddr (assoc 10 obj))))
				   )
			 )
		   (assoc 10 obj)
		   obj
		   )
		 )
	     )
	   )
	  (
	   (equal "LWPOLYLINE" (cdr (assoc 0 obj)))
	   (entmake
	       (vl-remove-if
		 (function
		   (lambda(td)
		     (member (car td) '(-1 330 5)
			     )
		     )
		   )
		 (mapcar
		   (function
		     (lambda (f)
		       (cond
			 (
			  (= (car f) 10)
			  (cons 10 (polar (cdr f)
					  (/ pi 2)
					  (* 2 (- y (caddr f)))
					  )
				)
			  )
			 (
			  (and
			    (= (car f) 42)
			    (/= 0.0 (cdr f))
			    )
			  (cons 42 (- (cdr f)))
			  )
			 (
			  f
			  )
			 )
		       )
		     )
		   obj
		   )
		 )
	     )
	   )
	  )
	)
      )
     (ssnamex ssl1)
    )
  (mapcar
    (function
      (lambda (wr)
	(entdel (cadr wr))
	)
      )
    (ssnamex ssl1)
    )
  (princ)
  )

MGK · 25.12.2011, 15:27

Цитата:

Сообщение от Oliver_88

Так должно рисовать нормально

А можно на подобии первоначального кода?

А то такого на парах не проходили))

Oliver_88 · 25.12.2011, 15:52

2004 када нет.Подумаешь, не проходили. Лапшу какую-нибудь навешай. Код далек от идеала.

MGK · 25.12.2011, 17:58

Цитата:

Сообщение от Oliver_88

2004 када нет.Подумаешь, не проходили. Лапшу какую-нибудь навешай. Код далек от идеала.

Эх, спасибо)) Надеюсь преподавателя тут нет на форуме

Спасибо)

Alan · 25.12.2011, 19:30

Цитата:

Сообщение от MGK

2. Он там работает! В универе только на нем и работаем.
3. Вот при снятии привязок, он может только один круг нарисовать, может нарисовать только половину контура, может по другой линии расположить круги

2. Боюсь, что в универе у вас всё-таки английский Акад. Алексей прав - твой код в локализованном (т.е. настоящем русском) Акаде работать не будет
3. Объектные привязки перед построениями всё-таки лучше отключать...

Код:

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

(defun q ()
  (vl-load-com)
    (setq oldosm (getvar "osmode")
      p   (getpoint "p - ?")
    a   (getreal "a - ?")
    x   (car p)
    y   (cadr p)
    p1  (list x y)
    p2  (list (- x a) y)
    p3  (list (- x (* 2 a)) (+ y a))
    p4  (list (- x (* 2 a)) (+ y (* 3.5 a)))
    p5  (list x (+ y (* 3.5 a)))
    p6  (list x (+ y (* 4 a)))
    p7  (list x (- y (/ a 2)))
    p8  (list (- x (* 1.7 a)) (+ y (* 3.2 a)))
    p9  (list (- x (* 1.7 a)) (+ y (* 2.7 a)))
    p10 (list (- x (* 1.7 a)) (+ y (* 2.2 a)))
    p11 (list (- x (* 1.7 a)) (+ y (* 1.7 a)))
    p12 (list (- x (* 1.7 a)) (+ y a))
    p13 (list (- x (* 0.45 a)) (+ y (* 0.3 a)))
    p14 (list (- x a) (+ y a))
    p16 (list (- x (* 1.7 a)) (+ y (* 3.4 a)))
    p17 (list (- x (* 1.7 a)) (+ y (* 3 a)))
    p18 (list (- x (* 1.9 a)) (+ y (* 3.2 a)))
    p19 (list (- x (* 1.5 a)) (+ y (* 3.2 a)))
    p20 (list (- x (* 1.9 a)) (+ y (* 3.4 a)))
    p21 (list (- x (* 1.5 a)) (+ y (* 3 a)))
    tl  (if    (vl-string-search "419" (vlax-product-key))
;;; Русская версия имя типа линии "осевая"
          "осевая"
          "center"
        ) ;_ конец if
  ) ;_ конец setq
;;;  Загрузим линию, если её нет
  (if (tblsearch "LTYPE" tl)
    nil
    (command "_.LINETYPE" "_L" tl "acadlin.iso"    "") ;_ конец command
  ) ;_ конец if
  (setvar "osmode" 0)
  (command "_pline" p1 "_w" 0.1 0.1 p2 "_a" p3 "_l" p4 p5 "")
  (command "_circle" p8 (/ a 8) )
   (command "_layer" "_n" "osi" "_l" tl "osi" "_s" "osi" "") 
  (command "_line" p6 p7 "" "_line" p16 p17 "" "_line" p18 p19 "")
  (command "_layer" "_s" "0" "")
  (command "_copy" "_c" p20 p21 "" p8 p9 "")
  (command "_copy" "_c" p20 p21 "" p8 p10 "")
  (command "_copy" "_c" p20 p21 "" p8 p11 "")
  (command "_copy" "_c" p20 p21 "" p8 p12 "")
  (command "_copy" "_c" p20 p21 "" p8 p13 "")
  (setq    m 1
    d (/ pi 6)
  ) ;_ конец setq
  (repeat 3
    (setq p15 (polar p14 (+ pi (* m d)) (* 0.7 a))
      m   (+ m 1)
    ) ;_ конец setq
    (command "_copy" "_c" p20 p21 "" p8 p15 "")
  ) ;_ конец repeat
  (command "_mirror" "_c" p7 p4 "" p6 p7 "")
   (setvar "osmode" oldosm)
) ;_ конец defun

Вот такой код тебе думаю будет более привычен/понятен. Да и у препода меньше к тебе вопросов.
Чем плохи "командные" методы. В них в разных версиях по разному заканчиваются. Например
Так работало во многих -
(command "_circle" p8 (/ a 8) "")(command "_copy" "_c" p20 p21 "" p8 p9 "")
Окончание ENTER.
Автокада 2004 под руками не было, проверял на 2002, там на ввод не надо нажимать
Вот это проверь уже в универе.

Цитата:

Сообщение от MGK

Надеюсь преподавателя тут нет на форуме

Ну бум надеяться.

Олег (jr.) · 25.12.2011, 19:38

Дельные добавления

gomer · 25.12.2011, 20:39

Цитата:

Сообщение от Alan

(command "_circle" p8 (/ a 8) "")

скаких это пор ТАК работало?

Alan · 25.12.2011, 20:56

Цитата:

Сообщение от gomer

скаких это пор ТАК работало?

у MGK

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Учёт ветра в "Лире" - как задать правильно?	shakuredo	Лира / Лира-САПР	5	08.10.2010 15:01
Подготовка к защите от коррозии. Как правильно?	Aндрeй	Конструкции зданий и сооружений	6	26.07.2008 19:57
Как правильно сделать сварную трубу из швеллеров?	Chief Justice	Прочее. Архитектура и строительство	36	01.04.2007 01:03
Правильно ли я делаю?	AlexRU	Прочее. Архитектура и строительство	13	24.03.2007 20:13
А ломаный скад (7.31 R4) правильно считает?	satch	SCAD	24	29.10.2004 10:01