Работа приложения в AutoCad 2013

Работа приложения в AutoCad 2013 · 15.12.2016, 09:30

Здравствуйте.
В приложении обмеры происходит сбой функции. В AutoCAD 2010 работала. Ошибку не могу найти. Если не сложно помогите разобраться.
Программа рисует линии по направлению и расстоянию. Потом увязывает ход.
Вот Код:

Код:

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

 (defun c:obmer ( )
                          (setvar "cmdecho" 0)
                                   (setvar "blipmode" 0)
                                            (setq xyz (getvar "ucsorg"))
(setq curosm (getvar "osmode"))
                               (setq prinab (ssadd) cond 1)

(command "_osnap" "_none")


(setq p0 (getpoint"\nУкажите начальную точку"))(setq dd 0)
(setq xp (cons (nth 0 p0) xp))(setq yp (cons (nth 1 p0) yp)) 
       (setq ang 1)
(while ang
  (setq ang (getangle p0 "\nУкажите направление промера"))
(if (/= ang nil)(progn
(setq d (getreal "\nВведите расстояние промера"))
  (setq p1 (polar p0 ang d))
(command "_line" p0 p1 "")

;=============================================================================
(setq pri (ssget "L"))
          (setq pri (ssname pri 0))
                   (setq prinab (ssadd pri prinab))
;=============================================================================
 (setq p0 p1)
          (setq xlast (nth 0 p0) )
                        (setq ylast (nth 1 p0)) 
       )))
              (setq npri (sslength prinab))     

(setq m (getstring "\nУравнять? <да> "))
(if (= m "")(progn 
;-----------------------------------------------------------------------------
(setq pur (getpoint "\nУкажите точку уравнивания"))
(setq dx (- (nth 0 pur) xlast)) (setq dy (- (nth 1 pur) ylast))
       (setq vx (/ dx (- npri 0)))(setq vy (/ dy (- npri 0)))

                        (while cond                            
(setq n 0 plist (list))
      (repeat npri 
               (setq pri (entget (ssname prinab n)))
                  (setq p0 (cdr (assoc '10 pri)))(setq p0 (mapcar '- p0 xyz))
                         (if (= n 0)(setq plist (cons p0 plist)))  
                  (setq p1 (cdr (assoc '11 pri))) (setq p1 (mapcar '- p1 xyz))
(setq len (distance p0 p1))
                        
           (setq angl (angle p0 (mapcar '+ p1 (list vx vy))))

           (if (= n 0)(setq p1 (polar p0 angl len) pcur p1)  
                      (setq p1 (polar pcur angl len) pcur p1))
                            (setq plist (cons p1 plist))
                                               (setq n (1+ n)) 
      )  ;закрытие repeat
;-----------------------------------------------------------------------------
;        вторая итерация
(setq dx (- (nth 0 pur) (nth 0 p1))) (setq dy (- (nth 1 pur) (nth 1 p1)))
       (setq vx (/ dx (- npri 0)))(setq vy (/ dy (- npri 0)))

   
(if (>= 0.005 (distance pur p1))(setq cond nil)(progn 

              (setq plist (reverse plist))      

          

  (command "_erase" prinab "")(command "_redraw")
;удаление прежних примитивов
                                           (setq prinab (ssadd))     
                        (setq n 0)  
            (_repeat (- (length plist) 1)
   (command "_line" (nth n plist) (nth (1+ n) plist) "")

(setq pri (ssget "_L"))
          (setq pri (ssname pri 0))
                   (setq prinab (ssadd pri prinab))

(setq n (1+ n)))

(setq n 0 plist (list))
      (repeat npri 
               (setq pri (entget (ssname prinab n)))
                  (setq p0 (cdr (assoc '10 pri)))(setq p0 (mapcar '- p0 xyz))
                         (if (= n 0)(setq plist (cons p0 plist)))  
                  (setq p1 (cdr (assoc '11 pri))) (setq p1 (mapcar '- p1 xyz))
(setq len (distance p0 p1))
                        
           (setq angl (angle p0 (mapcar '+ p1 (list vx vy))))

           (if (= n 0)(setq p1 (polar p0 angl len) pcur p1)  
                      (setq p1 (polar pcur angl len) pcur p1))
                            (setq plist (cons p1 plist))
                                               (setq n (1+ n)) 
      )  ;закрытие repeat
                            )) ;закрытие if progn
);закрытие while

                        (setq plist (cons pur (cdr plist)))

(command "_erase" prinab "")(command "_redraw")  ;удаление прежних примитивов
 (setq n 0)  
            (repeat (- (length plist) 1)
   (command "_line" (nth n plist) (nth (1+ n) plist) "")(setq n (1+ n)))
            
                           ));закрытие if
;-----------------------------------------------------------------------------
(setvar "osmode" curosm)
                           (princ)
)

Кулик Алексей aka kpblc · 15.12.2016, 10:35

Что за строки

Код:

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

 (setq prinab (ssadd)
        cond   1
        ) 
;...
(while cond
;...
(setq cond nil)

cond - зарезервированный символ. Используй другой.

valerik88 · 15.12.2016, 11:09

Батя починил, не вдаваясь в смысл программы.
И закомментировал изменение привязок.. а то слетают

Код:

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

 (defun c:obmer ( / xyz curosm prinab cond1 p0 xp dd yp p0 p1 yp ang d pri
		prinab npri m pur dx dy xlast ylast vx vy n len pcur)
  ;(setvar "cmdecho" 0)
  ;(setvar "blipmode" 0)
   (setq xyz (getvar "ucsorg"))
   (setq curosm (getvar "osmode"))
   (setq prinab (ssadd)
	 cond1 1)

   ;(command "_osnap" "_none")


  (setq p0 (getpoint"\nукажите начальную точку"))
  (setq dd 0)
  (setq xp (cons (nth 0 p0) xp))
  (setq yp (cons (nth 1 p0) yp))
  (setq ang 1)

  (while ang
  	(setq ang (getangle p0 "\nукажите направление промера"))
		(if (/= ang nil)
		  (progn
			(setq d (getreal "\n Введите рассто¤ние промера"))
		  	(setq p1 (polar p0 ang d))
			(command "_line" p0 p1 "")

			;===============================
			(setq pri (ssget "L"))
			(setq pri (ssname pri 0))
			(setq prinab (ssadd pri prinab))
			;================================
			(setq p0 p1)
			(setq xlast (nth 0 p0))
			(setq ylast (nth 1 p0)) 
	         );end progn
	  	);end if    
    );end while

(setq npri (sslength prinab))     

(setq m (getstring "\n”равн¤ть? <да> "))
  
(if (= m "")
  (progn 
	;----------------------
	(setq pur (getpoint "\n Укажите точку уравнивани¤"))
	(setq dx (- (nth 0 pur) xlast))
    	(setq dy (- (nth 1 pur) ylast))
        (setq vx (/ dx (- npri 0)))
    	(setq vy (/ dy (- npri 0)))

            (while cond1                            
		(setq n 0 plist (list))
		   (repeat npri 
		        (setq pri (entget (ssname prinab n)))
		        (setq p0 (cdr (assoc '10 pri)))(setq p0 (mapcar '- p0 xyz))
			(if (= n 0)(setq plist (cons p0 plist)));end if  
		        (setq p1 (cdr (assoc '11 pri)))
		     	(setq p1 (mapcar '- p1 xyz))
			(setq len (distance p0 p1))
		        (setq angl (angle p0 (mapcar '+ p1 (list vx vy))))
		           (if (= n 0)
			     (setq p1 (polar p0 angl len) pcur p1)  
		             (setq p1 (polar pcur angl len) pcur p1)
			   );end if
		        (setq plist (cons p1 plist))
		        (setq n (1+ n)) 
		      )  ;закрытие repeat
		;-------------
		;        втора¤ итераци¤
		(setq dx (- (nth 0 pur) (nth 0 p1)))
	        (setq dy (- (nth 1 pur) (nth 1 p1)))
		(setq vx (/ dx (- npri 0)))
	        (setq vy (/ dy (- npri 0)))

		(if (>= 0.005 (distance pur p1))
		  (setq cond1 nil)
		  (progn 
			(setq plist (reverse plist))      
			(command "_erase" prinab "")
		    	(command "_redraw")
			;удаление прежних примитивов
		        (setq prinab (ssadd))     
		        (setq n 0)  
		        (_repeat (- (length plist) 1)
		   	(command "_line" (nth n plist) (nth (1+ n) plist) "")
			(setq pri (ssget "_L"))
		        (setq pri (ssname pri 0))
		        (setq prinab (ssadd pri prinab))
			(setq n (1+ n)))
			(setq n 0 plist (list))
			      (repeat npri 
			          (setq pri (entget (ssname prinab n)))
			          (setq p0 (cdr (assoc '10 pri)))
				  (setq p0 (mapcar '- p0 xyz))
			          (if (= n 0)(setq plist (cons p0 plist)));end if  
			          (setq p1 (cdr (assoc '11 pri)))
				  (setq p1 (mapcar '- p1 xyz))
				  (setq len (distance p0 p1))
			          (setq angl (angle p0 (mapcar '+ p1 (list vx vy))))
				           (if (= n 0)
					      (setq p1 (polar p0 angl len) pcur p1)  
			                      (setq p1 (polar pcur angl len) pcur p1)
					    );end if
			          (setq plist (cons p1 plist))
			          (setq n (1+ n)) 
			      );закрытие repeat
		     );end progn
		  ) ;закрытие if
	);закрытие while

	(setq plist (cons pur (cdr plist)))
	(command "_erase" prinab "")
	(command "_redraw")  ;удаление прежних примитивов
	(setq n 0)  

		(repeat (- (length plist) 1)
			(command "_line" (nth n plist) (nth (1+ n) plist) "")
		  	(setq n (1+ n))
		);end repeat
	            
	);end progn
  );закрытие if
;-----------------------------------------------------------------------------
;(setvar "osmode" curosm)
                           (princ)
)

Рашит · 15.12.2016, 14:11

Приведённое не работает.
А мне кажется проблема ещё и в этом:
(setq pri (ssget "L")) так написано, срывается программа, но если поменять так: (setq pri (ssget "_L")) то работает до увязки.
После увязки оставляет одну линию, остальные стирает из за кода (setq cond nil).

----- добавлено через 31 сек. -----
Про резервированный символ cond не понял.

(setq pri (ssget "L")) присутствует в 2х местах по разному и (setq pri (ssget "_L")), не понимаю

.

valerik88 · 15.12.2016, 14:25

Цитата:

Сообщение от Рашит

Про резервированный символ cond не понял.

cond - это команда, на равне с while, if, repeat.... А у тебя в коде он как переменная используется. Я заменил его на cond1, что бы не конфликтовало.

Цитата:

Сообщение от Рашит

(setq pri (ssget "L")) присутствует в 2х местах по разному и (setq pri (ssget "_L"))

Везде на _L замени

Кроме того у тебя в коде все переменные глобальные, т.е. они сохраняют свои значения после выполнения функции. Я их все локальными сделал (вынес в определении функции в скобки). Если какие-то из них должны глобальными оставаться, их нужно удалить из скобок. Я в суть программы не вникал, поэтому ничего толком сказать не могу по работоспособности.

Рашит · 15.12.2016, 14:53

ГЫ, ГЫ, при замене на (setq pri (ssget "_L")) в обоих случаях программу выполняет, но по окончании увязки стирает все линии кроме первой.

valerik88 · 15.12.2016, 15:14

У меня ни чего не стирается. Рисуются линии, пока не отменю цикл нажатием на ESC.
Смысл программы так и не понял.

Рашит · 15.12.2016, 15:45

Смысл увязать несовпадающие концы отрезков при завершении отрисовки многоугольника.
У меня не работает, может дело в программе? У меня акад цивил 3Д 2013.
Вот такое написал:
Укажите точку уравнивания_endp ; ошибка: no function definition: _REPEAT
Заработало при условии убирания подчёркивания в этой строке:
****************(_repeat (- (length plist) 1) - ****************(repeat (- (length plist) 1)
СПАСИБО!!!!!

Кулик Алексей aka kpblc · 15.12.2016, 16:24

Цитата:

Сообщение от Рашит

Смысл увязать несовпадающие концы отрезков при завершении отрисовки многоугольника.

А кто мешает использовать _.pedit или вообще сразу полилинию?

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
AutoCAD 2013 при перезагрузке пропадают пользовательские меню	Sta1917	AutoCAD	12	11.05.2016 13:45
При установке AutoCAD 2013 (лицензия) появляется ошибка autodesk installer.	Yang	AutoCAD	12	01.10.2013 12:11
AutoCAD MEP 2013 Rus Как облегчить файл для чтения в Autocad 2007 Rus?	Sh_C	Вертикальные решения на базе AutoCAD	3	05.08.2013 10:52
Редактирование надписей в AutoCAD 2013	Соколов	AutoCAD	6	19.07.2013 05:08
Установлено 2 версии 2013 и 2009 AutoCAD. СПДС не может разобраться.	SNIIP	Прочее. Программное обеспечение	1	27.06.2013 12:25

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