Расчет геметрических характеристик сечений, черчение елипс инерции - не работает лисп

Student · 23.01.2004, 22:21

стянул я отсюдова http://www.helpstud.narod.ru/download.html лиспик к автокаду, который считает геметрические характеристики сечений, чертит елипс инерции..... Вобщем прикольный лисп, мне сильно помогал при проверке домашнего задания... И тут после того как я переустановил винду, ну и акад тоже, этот лиспик перестал работать, пишет вот это:

Код:

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

Command: i1 
Выбери замкнутые полилинии...
Select objects: Specify opposite corner: 2 found
Select objects:
1 loop extracted.
1 Region created.
; Ошибка: no function definition: VLAX-ENAME->VLA-OBJECT

і1- это команда вызова этого лиспа, сам лисп вот:

Код:

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

  ;******************************************************************
 ; Расчет геометрических характеристик сечения, составленого
 ; из замкнутых полилиний. С отрисовкой главных осей
 ; и эллипса инерции.
 ;******************************************************************
 ; AutoCAD R14, 2000
 ; Автор : Пурошев Сергей
 ; Донецкий центр союза архитекторов Украины "Среда"
 ; E-mail  [email protected]
 ;******************************************************************
 ;******************************************************************
(defun POLY  (A1 / _P1 _A1 _A2 _TIP _A200 _N_MAX _N1 _N2 _I N1 N2 _SP)
    (setq _A2 (entget A1))
    (setq _TIP (cdr (assoc 0 _A2)))
    (setq _A200 NIL)
 ;**************************************************************
    (if	(= _TIP "LWPOLYLINE")
	(progn
	    (setq _N_MAX (length _A2))
	    (setq _I 0)
	    (repeat _N_MAX
		(setq _SP (nth _I _A2))
		(if (= (car _SP) 10)
		    (setq _A200 (cons (cdr _SP) _A200))
		    )
		(setq _I (+ 1 _I))
		) ;Repeat
	    (setq _N_MAX (length _A200))
	    (setq _A200 (reverse _A200))
	    (setq _A200 (cons _N_MAX _A200))
	    ) ;progn
	) ;if
 ;**************************************************************
    (if	(= _TIP "LINE")
	(progn
	    (setq N1 (cdr (assoc 10 _A2)))
	    (setq N2 (cdr (assoc 11 _A2)))
	    (setq _A200 (list 2 N1 N2))
	    ) ;progn
	) ;if
 ;***************************************************************    
    (setq _A200 _A200)
    ) ;END DEFUN POLY
 ;***************************************************************
 ;************************* MAIN ********************************
 ;***************************************************************
(defun C:i1  (/ A ALFA	ALFA1 ALFA2 B C	D ED EN	F II JMAX JMIN JX
	       JXY JY K LLL MI MP N NABOR P1 P2 POINTS PR REG
	       SS T1 T2 T3 V2 V3 X XL XMA XMI XR XY Y YMA YMI
	       YN YV Z _F _JX _JY _SX _SY _X _Y)
    (setvar "CMDECHO" 0)
    (setq ss nil)
    (prompt "\nВыбери замкнутые полилинии...")
    (setq SS (ssget))
    (setq LLL nil)
    (setvar "DELOBJ" 0)
 ;************************************************************
    (setq Xmi 1.0e+099)    (setq Xma -1.0e+099)
    (setq Ymi 1.0e+099)    (setq Yma -1.0e+099)
    (setq _F 0.0)     (setq _x 0.0)
    (setq _Sx 0.0)    (setq _y 0.0)
    (setq _Sy 0.0)    (setq _Jx 0.0)
    (setq _Jy 0.0)    (setq Nabor Nil)
    (setq reg 0)
    (if	(/= SS NIL)
	(progn
	    (setq II 0)
	    (setq N (sslength SS))
 ;************************************************************		
	    (repeat N
		(setq EN (ssname SS II))
		(setq ED (entget EN))
		(setq V2 (assoc -1 ED))
		(setq V3 (cdr (assoc 0 ED)))
		(if (= V3 "LWPOLYLINE")
		    (progn
			(command "REGION" en "")
			(setq a (entlast))
			(if (= reg 0)
			    (progn
 				(setq reg 1)
				(setq b (entlast))
				)
			    (progn
				(command "UNION" a b "")
				(setq reg 1)
				(setq b (entlast))
				))
			(setq Points (poly EN))
			(setq K (- (length Points) 1))
			(setq z 1)
			(repeat	K
			    (if	(< (car (nth z Points)) Xmi)
				(setq Xmi (car (nth z Points))))
			    (if	(> (car (nth z Points)) Xma)
				(setq Xma (car (nth z Points))))
			    (if	(< (cadr (nth z Points)) Ymi)
				(setq Ymi (cadr (nth z Points))))
			    (if	(> (cadr (nth z Points)) Yma)
				(setq Yma (cadr (nth z Points))))
			    (setq z (+ z 1))
			    )
			) ; progn
		    ) ;end if
		(setq II (+ II 1))
		) ; Repeat
 	    )) ;SS nil
;************************************************************    
    (setq b (vlax-ename->vla-object b))
    (setq F (vlax-get-property b 'Area))
    (setq _F (+ _F F))
    (setq XY (vlax-get-property b 'Centroid))
    (setq XY (vlax-safearray->list (vlax-variant-value XY)))
    (setq X (car XY))
    (setq Y (cadr XY))
    (setq MI (vlax-get-property b 'MomentOfInertia))
    (setq MI (vlax-safearray->list (vlax-variant-value MI)))
    (setq Jx (- (car MI) (* y y F)))
    (setq Jy (- (cadr MI) (* x x F)))

    (setq MP (vlax-get-property b 'PrincipalMoments))
    (setq MP (vlax-safearray->list (vlax-variant-value MP)))
    (setq Jmin (car MP))
    (setq Jmax (cadr MP))
    (if (> Jmin Jmax) (setq Jmax (car MP) Jmin (cadr MP)))
    (setq Pr (vlax-get-property b 'Perimeter))
    (entdel a)
 ;***********************************************************************
    (setq xl (- x xmi))
    (setq xr (- xma x))
    (setq yn (- y ymi))
    (setq yv (- yma y))
    (setq a Jmax)
    (setq b (* 0.5 (+ Jx Jy)))
    (setq c (* (- Jx Jy) (- Jx Jy)))
    (setq d (* 2.0 (- a b)))
    (setq d (* d d))
    (setq Jxy (sqrt (* 0.25 (abs (- d c)))))
    (setq XY (- Jy Jx))
    (if	(equal Jy Jx 0.000001)
	(setq xy 0.000000000000001))
    (setq alfa (/ (* 2.0 Jxy) xy))
    (setq alfa1 (/ (* (atan alfa) 180.0) pi 2.0))
 ;************************************************************************
    (princ "\n**********************************************")
    (princ "\n********* РЕЗУЛЬТАТЫ РАСЧЕТА *****************")
    (princ "\n**********************************************")
    (princ "\nПлощадь сечения ............, = ")    (princ (/ F 1.0))
    (princ "\nПериметр сечения ..........., = ")    (princ (/ Pr 1.0))
    (princ "\nКоордината Х ц.т............, = ")    (princ (/ x 1.0))
    (princ "\nКоордината Y ц.т............, = ")    (princ (/ y 1.0))
    (princ "\n**********************************************")
    (princ "\nМомент инерции Jx..........., = ")    (princ (/ Jx 1.0))
    (princ "\nМомент инерции Jy..........., = ")    (princ (/ Jy 1.0))
    (princ "\nМомент инерции Jxy.........., = ")    (princ (/ Jxy 1.0))
    (princ "\nРадиус инерции ix..........., = ")    (princ (/ (sqrt (/ Jx F)) 1.0))
    (princ "\nРадиус инерции iy..........., = ")    (princ (/ (sqrt (/ Jy F)) 1.0))
    (princ "\n**********************************************")
    (princ "\nМомент сопротивления Wxdown., = ")    (princ (/ Jx yn 1.0))
    (princ "\nМомент сопротивления Wxup..., = ")    (princ (/ Jx yv 1.0))
    (princ "\nМомент сопротивления Wyleft., = ")    (princ (/ Jy xl 1.0))
    (princ "\nМомент сопротивления Wyrigh., = ")    (princ (/ Jy xr 1.0))
    (princ "\n**********************************************")
    (princ "\nМомент инерции Jmax........., = ")    (princ (/ Jmax 1.0))
    (princ "\nМомент инерции Jmin........., = ")    (princ (/ Jmin 1.0))
    (princ "\nРадиус инерции imax........., = ")    (princ (/ (sqrt (/ Jmax F)) 1.0))
    (princ "\nРадиус инерции imin........., = ")    (princ (/ (sqrt (/ Jmin F)) 1.0))
    (princ "\nУгол гл. центр. осей..., град = ")    (princ (rtos alfa1 2 2))
    (princ "\n**********************************************")
    (setq P1 (polar (list x y) 0.0 (- xma xmi)))
    (setq P2 (polar (list x y) pi (- xma xmi)))
    (command "LINE" P1 P2 "")
    (setq a (entlast))
    (command "CHANGE" a "" "p" "c" 1 "")
    (command "LINE" P1 P2 "")
    (setq b (entlast))
    (command "CHANGE" b "" "p" "c" 2 "")
    (setq P1 (polar (list x y) (/ pi 2.0) (- yma ymi)))
    (setq P2 (polar (list x y) (/ pi -2.0) (- yma ymi)))
    (command "LINE" P1 P2 "")
    (setq c (entlast))
    (command "CHANGE" c "" "p" "c" 1 "")
    (command "LINE" P1 P2 "")
    (setq d (entlast))
    (command "CHANGE" d "" "p" "c" 2 "")
    (command "ROTATE" b d "" (list x y) alfa1)
    (setq alfa2 (* 0.5 (atan alfa)))
 ; ** if **********************************************************
    (if	(< Jx Jy)
	(progn
	    (setq T1 (list x y 0.0))
	    (setq T2 (polar (list x y 0.0) alfa2 (sqrt (/ (/ Jmax F)))))
	    (setq T3 (polar (list x y 0.0) (+ (* 0.5 pi) alfa2) (sqrt (/ (/ Jmin F)))))
	    )
	(progn
	    (setq T1 (list x y 0.0))
	    (setq T2 (polar (list x y 0.0) alfa2 (sqrt (/ (/ Jmin F)))))
	    (setq T3 (polar (list x y 0.0) (+ (* 0.5 pi) alfa2) (sqrt (/ (/ Jmax F)))))
	    ))
 ; if **********************************************************	
    (command "ELLIPSE" "c" T1 T2 T3)
    (setq b (entlast))
    (command "CHANGE" b "" "p" "c" 3 "")
    (command "_textscr")     
    (princ)
    ); END DEFUN
(prompt "\nПриложение загружено. Введи i1 для запуска.")

В лиспе я не разбираюсь. Буду сильно благодарен за помощ.

vk · 24.01.2004, 00:19

Дбавь строку

Код:

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

(vl-load-com)

либо в самое начало, либо в самый конец файла.
А лучше прописать ее в какой нибудь из автозагружаемых файлов, чтоб другие программы, использующие аналогичные команды, не ворчали. Например, в acaddoc.lsp (если нет, то создать такой в Support'е)

Student · 24.01.2004, 09:41

ООО СУПЕР!!!! РАБОТАЕТ. СПАСИБА

А чего ж тогда раньше работал?, акад я ставлю с тогоже диска что и раньше, установку выбираю полную..

{Smirnoff} · 24.01.2004, 12:47

А я тоже кстати сталкивался. Где то читал что начиная с R15 подготовка к работе с ActiveX не нужна. Именно так у меня на работе, причем в ACADDOC.LSP (vl-load-com) тоже нет. А дома без этого функции не работают. Странненько... Конечно везде пишу, столкнулся случайно, когда принес домой функцию которую накарябал на работе и забыл (vl-load-com).

vk · 24.01.2004, 16:55

В принципе, загрузить расширенные функции VLISP достаточно один раз (не помню, в сеанс АКАДа или в чертеж

). Если к АКАДу установлено какое то приложенице, выполняющее эту функцию, то естественно, другие программы будут работать как ни в чем не бывало. А вот если расширенные функции никто не подгружал... :shock: то и получим сообщение вроде этого. От лишней загрузки (если она вобще происходит при повторных вызовах vl-load-com :?: ) пока глюков замечено не было.

Потому рекомендация следующая:
:!:
- программерам - прописывать функцию загрузки (vl-load-com) в код своих творений, дабы не пугать юзеров;
- юзерам - прописать эту функцию в автозагрузку, дабы избежать шишек от граблей нерадивых программеров.

Georg · 09.05.2005, 01:27

В этом лиспе есть глюк :?

рисует для зеркальных сечений одинаковый элипс инерции

и было-бы удобно если б он умел считать погонный вес конструкции, принимая что конструкия, скажем металлическая :P

Reka · 16.05.2008, 14:00

HELP!!! Перестал корректно? работать LISP.
Качнул давно уже с DWG.RU несколько LISPов, к-е оч. полюбились и постоянно используются в работе. ОГРОМНОЕ СПАСИБО ИХ АВТОРАМ!!! Сам пока до LISPa "не дошел".
Проблема. Вчера был в ком-ке. За моим компом кто-то поработал, причем без всяких умыслов. Догадываюсь даже кто. В результате сегодня часть LISPов не работает. Например, LISP отрисовки выносок "Pblok" (автор мне не известен) и отрисовки сварных швов "Weld" (автор Иван Минаев он же - scazochnik). Т.е. все панельки висят там где надо. Начинается выполнение команды, напр., запросы с отрисовкой, а затем все либо анигилируется (Выноска), либо не до конца прорисовывается (Weld). Файлы прилагаю.
С надеждой на то, что не прийдется принимать радикальные меры - а-ля переустановка!

Bull · 16.05.2008, 14:13

В следующий раз уедешь надолго, предварительно сделай перенос (экспорт) настроек (создается zip-файл). Придешь - что бы ни делали, делаешь импорт и работаешь спокойно.

Reka · 16.05.2008, 14:44

Цитата:

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

В следующий раз уедешь надолго, предварительно сделай перенос (экспорт) настроек (создается zip-файл). Придешь - что бы ни делали, делаешь импорт и работаешь спокойно.

Думаю AutoCAD вообще вряд-ли запускали. по меньшей мере это следует из списка последних документов.

Bull · 16.05.2008, 14:59

Тогда, может, Одмины колдовали с политикой безопасности?

alex-kolchugin · 14.06.2012, 12:37

а у меня другая проблемка...
Файл был скачан и немного переработан... Раньше всё идеально работало... потом некоторое время не пользовался... когда снова прога понадобилась, она работать не захотела почему-то...
Суть проблемы вообщем такова... когда доходит до отрисовки эллипса, Т1 хавает нормально, т. е. центр эллипса ставится куда нужно, а вот дальше пишет:

Значение должно быть положительным и ненулевым.
Функция отменена
Длина другой оси или [Поворот]:

т. е. насколько я сумел понять ему не нравятся Т2 и Т3

P. S. самое интересное, на одних компах она робит, а на других почему-то нет... Шаблоны на всех компах одинаковые, стили, слои и т. д., тоже... Ах, да, винда тожа на всех одинаковая))) На данный момент стоит AutoCAD 2010... Но пробовал в различных версиях, та же хрень... Переустанавливать AutoCAD пробовал и даже по случаю (всё равно давно собирался) систему перенакатил, нифига... помогите плиз...

Lymus · 14.02.2014, 17:41

Добрый вечер! Помогите пожалуйста, что нужно подправить в лиспе (достался от главного конструктора по наследству) После переустановки автокада не работает так как должен был, а должен был так: выдавать все геом. хар-ки сечения, с отчерчиванием всех осей и их подписанием. После расчета характеристик в ком. строке автокада выдается такое вот сообщение: "C:\geom.mpr": Can't open file
; error: bad argument type: FILE nil

Код:

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

 (defun C:sechen ()
(setvar "cmdecho" 0)
(setvar "osnapcoord" 1)
(if (= (getvar "dimscale") 0) (setq M 1) (setq M (getvar "dimscale"))) 
(setq 
     S    0
     LA   (getvar "clayer")
     ED   (getstring "\n Единицы измерения(1 -метры; 2 -сантиметры):<см> "))
(geom_region)
(if (= ED "1")
(setq 
    KR    1000
    EDt   " м")
);if
(if (or (= ED "2") (= ED ""))
(setq
    KR    10
    EDt   " см")
);if
(setq
    QQ1   (sslength KSP1)
    RSP1  (ssadd)
    N     0)
(repeat QQ1
(setq KSP (ssname KSP1 N))
(command "_.region" KSP "")
(setq
    RSP   (entlast)
    RSP1  (ssadd RSP RSP1)
    N     (+ 1 N))
);repeat QQ1 
(setq 
    NDT      (getvar "CDATE")
    NDT1     (substr (rtos NDT 2 8) 10 8)
    NDT2     (substr (rtos NDT 2 8) 1 8)
    NDTN     (strcat NDT2 NDT1)
    QQ       (sslength RSP1)
    NN       (ssname RSP1 0)
    N        1)   
(command "_.group" "" NDTN "" NN "")
(repeat (- QQ 1)
(setq
    NN       (ssname RSP1 N)
    N        (+ 1 N))
(command "_.group" "add" NDTN NN "")
);repeat
(setq dd (entlast))
(geom_read)
;**************ПЛОЩАДЬ************************************************************
(setq
    SS   (atof (substr (nth 3 SP) 15))
    SSR  (/ SS KR KR)
    SSt  (strcat "A = " (rtos SSR 2 4) EDt "2; "))
;**************ПЛОЩАДЬ************************************************************
;**************ПЕРИМЕТР***********************************************************
(setq
    PR   (/ (atof (substr (nth 4 SP) 15)) KR)
    PRt  (strcat "P = " (rtos PR 2 4) EDt "; "))
;**************ПЕРИМЕТР***********************************************************
;**************ЦЕНТР ТЯЖЕСТИ******************************************************
(setq
    XZT        (atof (substr (nth 7 SP) 25))
    YZT        (atof (substr (nth 8 SP) 25))
    XR2        (vl-string-search "--" (nth 5 SP) 25)
    YR2        (vl-string-search "--" (nth 6 SP) 25)
    XK1        (atof (substr (nth 5 SP) 25 (- XR2 25 1)))
    YK1        (atof (substr (nth 6 SP) 25 (- XR2 25 1)))
    XK2        (atof (substr (nth 5 SP) (+ XR2 3)))
    YK2        (atof (substr (nth 6 SP) (+ YR2 3)))
    TZT        (list XZT YZT)
    TK1        (list XK1 YK1)
    TK2        (list XK2 YK2)
    T_x1       (list (- XK1 10) YZT)
    T_x2       (list (+ XK2 10) YZT)
    T_y1       (list XZT (- YK1 10))
    T_y2       (list XZT (+ YK2 10))
    T_x_txt1   (list (- XK1 10 (* 3 M)) YZT)
    T_x_txt2   (list (+ XK2 10 (* 3 M)) YZT)
    T_y_txt1   (list XZT (- YK1 10 (* 3 M)))
    T_y_txt2   (list XZT (+ YK2 10 (* 3 M))) 
    H          (* 2.5 M))
(command "_.linetype" "s" "hidden" "")
(setvar "celtscale" (* 0.5 M)) 
(command "_.color" "1")
(command "_.rectang" TK1 TK2)
(command "_.linetype" "s" "center" "")
(setvar "celtscale" (* 10 M)) 
(command "_.line" T_x1 T_x2 "")
(command "_.line" T_y1 T_y2 "")
(command "_.linetype" "s" "bylayer" "")
(setvar "celtscale" 1)
(command "_.text" "m" T_x_txt1 H 0 "X")
(command "_.text" "m" T_x_txt2 H 0 "X")
(command "_.text" "m" T_y_txt1 H 0 "Y")
(command "_.text" "m" T_y_txt2 H 0 "Y")
(command "layer" "s" LA "")
(command "_.linetype" "s" "bylayer" "")
(command "_.color" "bylayer")
;**************ЦЕНТР ТЯЖЕСТИ******************************************************
;**************ИЗМЕНЕНИЕ UCS(ПЕРЕНОС)*********************************************
(command "_.ucs" "m" TZT)
(geom_read)
(command "_.erase" DD "")
(command "_.ucs" "w")
;**************ИЗМЕНЕНИЕ UCS(ПЕРЕНОС)*********************************************
;**************МОМЕНТЫ ИНЕРЦИИ UCS************************************************
(setq
    M_x    (atof (substr (nth 9 SP) 25))
    M_y    (atof (substr (nth 10 SP) 25))
    M_xR   (/ M_x KR KR KR KR)
    M_yR   (/ M_y KR KR KR KR)
    M_xt   (strcat "Jx = " (rtos M_xR 2 4) EDt "4; ")
    M_yt   (strcat "Jy = " (rtos M_yR 2 4) EDt "4; "))
;**************МОМЕНТЫ ИНЕРЦИИ UCS************************************************
;**************МОМЕНТЫ СОПРОТИВЛЕНИЯ UCS******************************************
(setq
    W_x_max   (/ M_x (min (abs (- YK2 YZT)) (abs (- YZT YK1))))
    W_x_min   (/ M_x (max (abs (- YK2 YZT)) (abs (- YZT YK1)))) 
    W_y_max   (/ M_y (min (abs (- XK2 XZT)) (abs (- XZT XK1)))) 
    W_y_min   (/ M_y (max (abs (- XK2 XZT)) (abs (- XZT XK1))))
    W_x_maxR  (/ W_x_max KR KR KR)
    W_x_minR  (/ W_x_min KR KR KR)
    W_y_maxR  (/ W_y_max KR KR KR)
    W_y_minR  (/ W_y_min KR KR KR)
    W_x_maxt  (strcat "Wx_max = " (rtos W_x_maxR 2 4) EDt "3; ")
    W_x_mint  (strcat "Wx_min = " (rtos W_x_minR 2 4) EDt "3; ")
    W_y_maxt  (strcat "Wy_max = " (rtos W_y_maxR 2 4) EDt "3; ")
    W_y_mint  (strcat "Wy_min = " (rtos W_y_minR 2 4) EDt "3; "))
;**************МОМЕНТЫ СОПРОТИВЛЕНИЯ UCS******************************************
;**************РАДИУСЫ ИНЕРЦИИ UCS************************************************
(setq
    i_xR   (sqrt (/ M_xR SSR))
    i_yR   (sqrt (/ M_yR SSR))
    i_xt   (strcat "ix = " (rtos i_xR 2 4) EDt "; ")
    i_yt   (strcat "iy = " (rtos i_yR 2 4) EDt "; "))
;**************РАДИУСЫ ИНЕРЦИИ UCS************************************************
;**************ПОВОРОТ СЕЧЕНИЯ****************************************************
(setq
    VRN    (vl-string-search "[" (nth 15 SP) 25)
    VRC    (vl-string-search " " (nth 15 SP) VRN)
    VRK    (vl-string-search "]" (nth 15 SP) VRC)
    KTR    (substr (nth 15 SP) vrn 2)
    VEC_x  (atof (substr (nth 15 SP) (+ VRN 2) (- VRC VRN 1)))
    VEC_y  (atof (substr (nth 15 SP) (+ VRC 2) (- VRK VRC 1))))
(if (not (or (and (= VEC_x 0) (= VEC_y 1)) (and (= VEC_x 1) (= VEC_y 0)) (and (= VEC_x 0) (= VEC_y -1)) (and (= VEC_x -1) (= VEC_y 0))))
(progn
(setq
    S         1
    TVEC_n    (list (+ XZT (* VEC_x 100)) (+ YZT (* VEC_y 100)))
    UG_n      (angle TZT TVEC_n)
    UG_y_r    (- (/ (* 270 PI) 180) UG_n)
    UG_y_g    (* UG_y_r (/ 180 PI))
    QQ2   (sslength KSP2)
    RSP2  (ssadd)
    N     0)
(repeat QQ2
(setq KSP (ssname KSP2 N))
(command "_.rotate" KSP "" TZT UG_y_g)
(setq N (+ 1 N))
);repeat QQ2
(setq
    RSP2  (ssadd)
    N     0)
(repeat QQ2
(setq KSP (ssname KSP2 N))
(command "_.region" KSP "")
(setq
    RSP   (entlast)
    RSP2  (ssadd RSP RSP2)
    N     (+ 1 N))
);repeat QQ2 
(setq 
    NDT      (getvar "CDATE")
    NDT1     (substr (rtos NDT 2 8) 10 8)
    NDT2     (substr (rtos NDT 2 8) 1 8)
    NDTN     (strcat NDT2 NDT1)
    QQ       (sslength RSP2)
    NN       (ssname RSP2 0)
    N        1)   
(command "_.group" "" NDTN "" NN "")
(repeat (- QQ 1)
(setq
    NN       (ssname RSP2 N)
    N        (+ 1 N))
(command "_.group" "add" NDTN NN "")
);repeat
(setq dd (entlast))
(geom_read)
(setq
    XZT        (atof (substr (nth 7 SP) 25))
    YZT        (atof (substr (nth 8 SP) 25))
    XR2        (vl-string-search "--" (nth 5 SP) 25)
    YR2        (vl-string-search "--" (nth 6 SP) 25)
    XK1        (atof (substr (nth 5 SP) 25 (- XR2 25 1)))
    YK1        (atof (substr (nth 6 SP) 25 (- XR2 25 1)))
    XK2        (atof (substr (nth 5 SP) (+ XR2 3)))
    YK2        (atof (substr (nth 6 SP) (+ YR2 3)))
    TK1        (list XK1 YK1)
    TK2        (list XK2 YK2)
    T_x1       (list (- XK1 10) YZT)
    T_x2       (list (+ XK2 10) YZT)
    T_y1       (list XZT (- YK1 10))
    T_y2       (list XZT (+ YK2 10))
    T_x_txt1   (list (- XK1 10 (* 3 M)) YZT)
    T_x_txt2   (list (+ XK2 10 (* 3 M)) YZT)
    T_y_txt1   (list XZT (- YK1 10 (* 3 M)))
    T_y_txt2   (list XZT (+ YK2 10 (* 3 M))))
(command "_.linetype" "s" "hidden" "")
(setvar "celtscale" (* 0.5 M)) 
(command "_.color" "92")
(command "_.rectang" TK1 TK2)
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.linetype" "s" "center" "")
(setvar "celtscale" (* 10 M)) 
(command "_.line" T_x1 T_x2 "")
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.line" T_y1 T_y2 "")
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.erase" DD "")
(command "_.linetype" "s" "bylayer" "")
(setvar "celtscale" 1)
(command "_.text" "m" T_x_txt1 H 0 "X_g")
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.text" "m" T_x_txt2 H 0 "X_g")
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.text" "m" T_y_txt1 H 0 "Y_g")
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.text" "m" T_y_txt2 H 0 "Y_g")
(command "_.rotate" (entlast) "" TZT (* -1 UG_y_g))
(command "_.layer" "s" LA "")
(command "_.linetype" "s" "bylayer" "")
(command "_.color" "bylayer")
(command "_.ucs" "w")
;**************ПОВОРОТ СЕЧЕНИЯ****************************************************
;**************ГЛАВНЫЕ МОМЕНТЫ ИНЕРЦИИ********************************************
(setq
    M_x1     (atof (substr (nth 15 SP) 25 (- VRN 25)))
    M_y1     (atof (substr (nth 16 SP) 25 (- VRN 25)))
    M_x      (max M_x1 M_y1)
    M_y      (min M_x1 M_y1)
    M_xR     (/ M_x KR KR KR KR)
    M_yR     (/ M_y KR KR KR KR)
    M_xt_g   (strcat "Jx_g = " (rtos M_xR 2 4) EDt "4; ")
    M_yt_g   (strcat "Jy_g = " (rtos M_yR 2 4) EDt "4; "))
;**************ГЛАВНЫЕ МОМЕНТЫ ИНЕРЦИИ********************************************
;**************ГЛАВНЫЕ РАДИУСЫ ИНЕРЦИИ********************************************
(setq
    i_xR     (sqrt (/ M_xR SSR))
    i_yR     (sqrt (/ M_yR SSR))
    i_xt_g   (strcat "ix_g = " (rtos i_xR 2 4) EDt "; ")
    i_yt_g   (strcat "iy_g = " (rtos i_yR 2 4) EDt "; "))
;**************ГЛАВНЫЕ РАДИУСЫ ИНЕРЦИИ********************************************
;**************ГЛАВНЫЕ МОМЕНТЫ СОПРОТИВЛЕНИЯ**************************************
(setq
    W_x_max     (/ M_x (min (abs (- YK2 YZT)) (abs (- YZT YK1))))
    W_x_min     (/ M_x (max (abs (- YK2 YZT)) (abs (- YZT YK1)))) 
    W_y_max     (/ M_y (min (abs (- XK2 XZT)) (abs (- XZT XK1)))) 
    W_y_min     (/ M_y (max (abs (- XK2 XZT)) (abs (- XZT XK1))))
    W_x_maxR    (/ W_x_max KR KR KR)
    W_x_minR    (/ W_x_min KR KR KR)
    W_y_maxR    (/ W_y_max KR KR KR)
    W_y_minR    (/ W_y_min KR KR KR)
    W_x_maxt_g  (strcat "Wx_max_g = " (rtos W_x_maxR 2 4) EDt "3; ")
    W_x_mint_g  (strcat "Wx_min_g = " (rtos W_x_minR 2 4) EDt "3; ")
    W_y_maxt_g  (strcat "Wy_max_g = " (rtos W_y_maxR 2 4) EDt "3; ")
    W_y_mint_g  (strcat "Wy_min_g = " (rtos W_y_minR 2 4) EDt "3; "))
;**************ГЛАВНЫЕ МОМЕНТЫ СОПРОТИВЛЕНИЯ**************************************
);progn
);if
(command "_.regen")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt "\n")
(prompt (strcat "Площадь сечения " SSt "\n"))
(prompt (strcat "Периметр сечения " PRt "\n"))
(prompt (strcat "Момент инерции " M_xt "\n"))
(prompt (strcat "Момент инерции " M_yt "\n"))
(prompt (strcat "Радиус инерции " i_xt "\n"))
(prompt (strcat "Радиус инерции " i_yt "\n"))
(prompt (strcat "Момент сопротивления " W_x_maxt "\n"))
(prompt (strcat "Момент сопротивления " W_x_mint "\n"))
(prompt (strcat "Момент сопротивления " W_y_maxt "\n"))
(prompt (strcat "Момент сопротивления " W_y_mint "\n"))
(if (= S 1)
(progn
(prompt (strcat "Главный момент инерции " M_xt_g "\n"))
(prompt (strcat "Главный момент инерции " M_yt_g "\n"))
(prompt (strcat "Главный радиус инерции " i_xt_g "\n"))
(prompt (strcat "Главный радиус инерции " i_yt_g "\n"))
(prompt (strcat "Главный момент сопротивления " W_x_maxt_g "\n"))
(prompt (strcat "Главный момент сопротивления " W_x_mint_g "\n"))
(prompt (strcat "Главный момент сопротивления " W_y_maxt_g "\n"))
(prompt (strcat "Главный момент сопротивления " W_y_mint_g "\n"))
);progn
);if
(textscr)
(if (= S 0)
(progn
(setq
    N     0
    QQ2   (sslength KSP2))
(repeat QQ2
(setq
    NN    (ssname KSP2 N))
(command "_.erase" NN "")
(setq N (+ 1 N))
);repeat QQ2  
);progn
);if
);defun
;******************************************************************************
;******************************************************************************
(defun geom_region ();по области
(setq
     KSP1   (ssadd)
     KSP2   (ssadd))
(while (setq TKP (getpoint "\n Покажите точку внутри элемента: "))
(command "_.boundary" TKP "")
(setq
     KKP1    (entlast))
     KSP1    (ssadd KKP1 KSP1)
(command "_.boundary" TKP "")
(setq
     KKP2    (entlast))
     KSP2    (ssadd KKP2 KSP2)
(redraw KKP2 3)
);while 
(command "_.regen")  
);geom_region
;*******************************************************************************
;*******************************************************************************
(defun geom_read ()
(vl-file-delete "c:\\geom.mpr")
(command "_.massprop" DD "" "y" "c:\\geom")
(setq
    SP    ()
    FO    (open "c:\\geom.mpr" "r"))
(while (setq STR (read-line FO))
(setq SP (cons STR SP))
);while
(close FO)
(setq SP (reverse SP))
(vl-file-delete "c:\\geom.mpr")
);geom_read
(vl-load-com)

Олег (jr.) · 14.02.2014, 20:49

Вообще-то лучше все переменные указывать как локальные
типа

Код:

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

 (defun C:sechen ( / ;|тут все переменные|;)
.....................

Навскидку попробуй так

Код:

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

(defun C:sechen () 
(vl-load-com)
 (setvar "cmdecho" 0) 
 (setvar "osmode" 0) 
(setvar "osnapcoord" 1) 
;;; Далее остальной код

Do$ · 15.02.2014, 14:04

Автокад ругается, что файл открыть не может. На диск C разрешена запись? Вообще, лучше по другому создавать временный файл, в VisualLISP даже функция есть для определения местоположения и имени для временных файлов: http://docs.autodesk.com/ACD/2011/EN...b7ccc-68b8.htm. Ну или выберите любой другой каталог, к которому гарантировано будет доступ на запись-чтение.
Речь идет про этот последний участок кода:

Код:

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

 (defun geom_read ()
(vl-file-delete "c:\\geom.mpr")
(command "_.massprop" DD "" "y" "c:\\geom")
(setq
    SP    ()
    FO    (open "c:\\geom.mpr" "r"))
(while (setq STR (read-line FO))
(setq SP (cons STR SP))
);while
(close FO)
(setq SP (reverse SP))
(vl-file-delete "c:\\geom.mpr")
);geom_read

Lymus · 17.02.2014, 10:27

Цитата:

Сообщение от Do$

Автокад ругается, что файл открыть не может. На диск C разрешена запись? Вообще, лучше по другому создавать временный файл, в VisualLISP даже функция есть для определения местоположения и имени для временных файлов: http://docs.autodesk.com/ACD/2011/EN...b7ccc-68b8.htm. Ну или выберите любой другой каталог, к которому гарантировано будет доступ на запись-чтение.
Речь идет про этот последний участок кода:

Код:

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

 (defun geom_read ()
(vl-file-delete "c:\\geom.mpr")
(command "_.massprop" DD "" "y" "c:\\geom")
(setq
    SP    ()
    FO    (open "c:\\geom.mpr" "r"))
(while (setq STR (read-line FO))
(setq SP (cons STR SP))
);while
(close FO)
(setq SP (reverse SP))
(vl-file-delete "c:\\geom.mpr")
);geom_read

Спасибо огромное, изменил на диск D и все заработало. Догадывался что проблема где то рядом

----- добавлено через ~58 мин. -----
Код работает, но на моем компе выдавая все характеристики сечения и еще дополнительно зеркалит копию сечения параллельно осям Х и У, у коллег по работе выдает все хар-ки без дополнительной копии параллельной осям Х и У, автокады одинаковой версии.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Документация Проектировщику на Torrents	DEM	Разное	262	24.02.2024 17:19
Жилые и общественные здания: краткий справочник инженера-конструктора. Под ред. Ю.А. Дыховичного и В.И. Колчунова. 2011 (Впечатления и отзывы).	Armin	Поиск литературы, чертежей, моделей и прочих материалов	19	22.03.2018 15:41
Фундамент с динамическими нагрузками в Scad	Tlelaxu	SCAD	9	31.08.2007 10:44

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