[faust999]

Помогите пожалуйста. Имеется программа на писаная на лиспе давно. Не могу добиться ее работоспособности в 2008 автокаде.

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

Код:

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

;-------------- Function to convert degrees to radians ------------- 
(defun DTR (a) 
 (* pi (/ a 180.0)) 
) 
;----------------------- Function's -------------------------------- 
(defun Stepen (a b) 
  (exp (* b (log a))) 
) 
(defun Tan (v) 
  (/ (sin v) (cos v)) 
) 
(defun KoordNew()  
  (cdr (assoc 10 (entget (entlast)))) 
) 
(defun KoordEnd() 
  (cdr (assoc 11 (entget (entlast)))) 
) 
;-----------------д-жЁп Setting------------------------------------- 
(defun Sett() 
(setq cmde (getvar "CMDECHO")) 
(setvar "CMDECHO" 0) 
(setq blmd (getvar "BLIPMODE")) 
(setvar "BLIPMODE" 0) 
;(command "layer" "n" "kav" "c" "5" "kav");--«Ё*Ёп Є ў «мҐp  
;(command "n" "kanal" "c" "3" "kanal") ;-------«Ё*Ёп Є * «  
;(command "n" "napr" "c" "4" "napr") ;-------«Ё*Ёп * Їp ў«пойЁе 
;(command "n" "plug" "c" "6" "plug") ;-------«Ё*Ёп Ї«гЈ  
;(command "n" "os" "l" "centerx2" "os" "c" "2" "os" "") ;--гбв *®ўЁ«Ё 
                                                       ;®бҐўго «Ё*Ёо 
) 
;-----------------д-жЁп Input_Fun----------------------------------- 
(defun Input_Fun() 
(prompt "\nInput H=")(setq h (getreal));---ўлб®в  Є * «  
(prompt "\nInput b=")(setq bb (getreal));---иЁpЁ*  Є * «  Ї® ¤*г 
(prompt "\nInput m=")(setq m (getreal));---Є®ндд. § «®¦. ®вЄ®б®ў 
(prompt "\nInput fl=")(setq fl (getreal)) 
(prompt "\nInput al=")(setq al (getreal)) 
(prompt "\nInput aotv=")(setq aotv (getreal)) 
(prompt "\nInput fg=")(setq tgfg (getreal));--Є®ндд. вpҐ*Ёп Јpг*в  
(prompt "\nInput kp=")(setq kp (getreal));---Є®ндд. p §pле«. Јpг*в  
(setq fotv 90) 
(setq ctgfg (/ 1 tgfg)) 
(setq b2 (/ bb 2)) 
(setq hp (* h 2));------hp Ї®«* п ўлб®в   
(setq vrem1 (* h kp (+ bb (* h m)))) 
(setq hk (+ h (sqrt (/ vrem1 (* 2 ctgfg)))));--ўлб®в  Є ў «мҐp  
(setq b1 (+ (* h m) b2));---b1-иЁpЁ*  Є * «  Ї® ўҐpег 
(setq b3 (+ (* (- hk h) ctgfg) b1));b3-иЁpЁ*  Є * «  Ї® ўҐpег ў¬Ґб⥠
                                   ;б Є ў «мҐp®¬ 
(setq bkx (+ (* (- b3 b1) 2) b1));--bkx-иЁpЁ*  Є ў «мҐp  Ї® ®бЁ • 
(setq zk (* 0.25 h)) 
(setq ctgfl (/ 1 (* (tan (DTR fl)) (sin (DTR al))))) 
(setq xk (* zk ctgfl)) 
(setq l (* 0.75 hp)) 
(setq hp2 (Stepen hp 2)) 
(setq hp3 (Stepen hp 3)) 
(setq zk2 (Stepen zk 2)) 
(setq zk3 (Stepen zk 3)) 
(setq vrem1 (+ bkx b1)) 
)  
;-----------------д-жЁп Kontur-------------------------------------- 
(defun Kontur() 
(setq dxucs (- dx (+ bkx 50)) )  
(command "_ucs" "_o" (list dxucs dy)) 
;(SetLayer "kanal") 
(command "_line") 
(command (list dx dy) (list b2 dy) (list b1 h) (list (+ bkx 25) h) 
         "");pЁб㥬 Є ў «мҐp 
;(SetLayer "kav") 
(command "_line" (list b1 h) (list b3 hk) (list bkx h) ) 
;(SetLayer "napr") 
(setq pz (+ hk (* 0.3 h)) ) 
(command "_line" (list b3 hk) (list b3 pz) (list dx pz) "") 
) 
;------------------------д-жЁп SetLayer----------------------------- 
(defun SetLayer(name) 
(command "_layer" "_s" name "") 
) 
;------------------------ д-жЁп Abcd ------------------------------- 
(defun Abcd() 
(setq i 1000) 
(setq zk (/ zk i ) hp (/ hp i) xk (/ xk i) l (/ l i) ) 
(setq zk2 (/ zk2 (Stepen i 2)) zk3 (/ zk3 (Stepen i 3)) ) 
(setq a (- (/  ctgfl (Stepen (* -1 (- zk hp)) 2))  
           (/ (* 2 (- xk l)) (* -1 (Stepen (* -1 (- zk hp)) 3)))) ) 
(setq b (/ (- (/ ctgfl (- zk hp)) (* 3 a (+ zk hp))) 2) ) 
(setq c (- ctgfl (* 3 a zk2) (* 2 b zk) )) 
(setq d (- xk (* a zk3) (* b zk2) (* c zk) )) 
(setq a2 (/ (- al aotv) (- (+ (* fotv fotv) (* fl fl) ) 
                              (* 2 fl fotv) ) )) 
(setq a1 (- (* 2 a2 fotv) )) 
(setq a0 (+ aotv (* a2 fotv fotv) )) 
(setq zk (* zk i) hp (* hp i) xk (* xk i) l (* l i) ) 
(setq zk2 (* zk2 (Stepen i 2)) zk3 (* zk3 (Stepen i 3)) ) 
) 

;----------------------- д-жЁп Raschet ----------------------------- 
(defun Raschet() 
(setq pii (/ 180 pi)) 
;(SetLayer "napr")		 
(setq sch 1) 
(repeat 12 
   (if (= sch 1) (setq delta fl) 
       (setq delta (+ delta (/ (- 89.9 fl) 11) ) 
       ) 
   );--end of IF 
   (setq alfa (+ a0 (* a1 delta) (* a2 delta delta) ) 
   ) 
   (setq k (/ 1 (* (tan (DTR delta)) (sin (DTR alfa)) ) ) 
   ) 
   (setq zz (/ (- (- b) (sqrt (+ (* b b) (* 3 a (- k c))))) (* 3 a)) 
   ) 
   (setq xx (+ d (* c zz) (* b (Stepen zz 2)) (* a (Stepen zz 3))) 
   ) 

   (setq ll (+ (sin (DTR alfa)) (* 0.5 (+ a1 (* 2 a2 delta)) 
                                       (sin (DTR (* 2 delta))) 
                                       (cos (DTR alfa)))) 
   ) 
   (setq mm (- (cos (DTR alfa)) (* 0.5 (+ a1 (* 2 a2 delta)) 
                                       (sin (DTR (* 2 delta))) 
                                       (sin (DTR alfa)))) 
   ) 
   (setq qq (* (STEPEN (sin (DTR delta)) 2) (+ a1 (* 2 a2 delta))) 
   ) 
   (setq xy (+ 90 (* (atan ll mm) pii)) 
   ) 
   (setq yz (* (atan qq ll) pii) 
   ) 
   (setq zx (* (atan mm qq) pii) 
   ) 
   (setq zx (- 180 zx)) 
  
   (Plot) 

   (setq sch (1+ sch)) 
    
);--end of REPIAT 

;(SetLayer "0") 
(setq yvrem (- (abs (/ b1 (tan (DTR xy)))))) 
(setq yvrem (+ koord1 yvrem)) 
(setq sch (+ pointy (- (* 6 hlit)))) 
(command "_line" (list b2 (+ koord1 (- (abs (/ b2 (tan (DTR xy))))))) 
                 (list b2 sch) "") 
(command "_line" (list b1 yvrem) (list b1 sch) "");«Ё*ЁЁ Є * «  
(setq yvrem (+ koord1 (- (abs (/ b3 (tan (DTR xy))))))) 
(command "_line" (list b3 yvrem) (list b3 sch) "") 
(Shtrishx b1 sch) 
(Shtrishx b3 sch) 
(command "_line" (list (+ x (* 6 hlit)) hk) (list (+ x 50) hk) "") 
(command "_line" (list (+ x (* 6 hlit)) h) (list (+ x 50) h) "") 
(command "_extend" "c" (list vrem1 dy) (list x z1) "" (list (+ x 51) hk) (list (+ x 51) h) "") 
(Shtrishy (+ x (* 6 hlit)) hk) 
(Shtrishy (+ x (* 6 hlit)) h) 
(command "_line" (list xx1 dy) (list (+ x (* 6 hlit)) dy) "") 

(command "_mirror" "c" (list (+ dx 2) sch) (list (+ bkx 25) 
                                                (+ hp bb))) 
(command "" (list dx (+ dy 10)) (list dx (- dy 10)) "n") 
) 

(defun Shtrishx(o p) 
(setq ww 0) 
(repeat 5 
(if (= ww 1) (setq o1 (- o (* 0.5 bb)) ww 0) 
	(setq o1 (- o (* 0.75 bb)) ww 1)  
) 
(command "_line" (list o p) (list o1 p) "") 
(setq p (+ p hlit)) 
) 
) 

(defun Shtrishy(o p) 
(setq ww 0) 
(repeat 5 
(if (= ww 1) (setq p1 (- p (* 0.5 bb)) ww 0) 
	(setq p1 (- p (* 0.75 bb)) ww 1)  
) 
(command "_line" (list o p) (list o p1) "") 
(setq o (- o hlit)) 
) 
) 

;------------------------ д-жЁп Plot ------------------------------- 
;pЁбгҐв * Їpaў«пойЁҐ ў 3 Ї«®бЄ®бвпе  
(defun Plot()  
   (setq koord2 (* 10 (tan (DTR (- 0 yz))))) 
   (setq koord1 (* 1000 zz)) 
   (command "_line" (list dx koord1) (list 10 (+ koord1 koord2)) "")  
   (command "_extend" "_c" (list b2 dy) (list b3 (+ 5 hk)) ""  
      (list 10 (+ koord1 koord2)) "") 

   (setq x1 (- (abs dxucs) (abs (car (KoordEnd)))) 
   ) 
   (setq z1 (cadr (KoordEnd)) 
   ) 
   (setq koord2 (* x1 (tan (DTR xy)))) 
   (setq koord1 (- (+ bb (* 1000 xx)))) 
   (setq pointy (- (+ (abs koord1) (abs koord2)))  
   )  
   (setq koord2 (* bb (tan (DTR (- 90 al))))) 
   (setq dypl (- (+ bb (abs koord2)))  
   )  
   (command "_line" (list dx koord1)  
                    (list x1 pointy) "" 
   );---pЁбговбп * Їp ў«пойЁҐ ў Ї«®бЄ®бвЁ XY 

   (setq xx (+ vrem1 (* 1000 xx)) zz (* 1000 zz) x (+ vrem1 
                                                   (abs pointy))) 
   (command "_line" (list xx zz) 
                    (list x z1) "" 
   );---pЁбговбп * Їp ў«пойЁҐ ў Ї«®бЄ®бвЁ XZ 

;   (SetLayer "plug") 
   (if (> sch 1) (progn  
                 (command "_line" (list oldx1 oldpointy) 
                                  (list x1 pointy) "") 
		 (command "_line" (list oldx oldz1) (list x z1) "") 
		 (command "_line" (list oldxx oldzz) (list xx zz) "") 
;-------аЁбгҐвбп Љ‘Ћ 
                 (command "_line" (list (+ olddelta vrem1) 
                                        (- oldalfa hk))  
                                  (list (+ delta vrem1)  
                                        (- alfa hk)) "") 
                 ) 
       (progn  
         (command "_line" (list dx (- 0 bb)) (list b2 dypl) 
                          (list x1 pointy) "" 
         ) ;--pЁбгҐвбп Ї«гЈ ў Ї«®бЄ®бвЁ XY 
         (command "_line" (list vrem1 dy) (list xx zz) "") 
         (command "_line" (list vrem1 dy) (list xx dy) 
                          (list x z1) "") 
         (setq delta2 delta alfa2 alfa xx1 xx) 
       ) 
   );------------END of IF 
   (setq oldpointy pointy oldx1 x1) 
   (setq oldx x oldz1 z1 oldxx xx oldzz zz) 
   (setq olddelta delta oldalfa alfa) 
   (if (> sch 11) (progn 
                    (command "_line" (list x1 pointy) 
                                     (list dx koord1) "") 
                    (command "_line" (list xx zz) (list xx pz) 
                     (list x pz) (list x z1) "") 
                  ) 
   ) 
  ; (SetLayer "napr") 
) 
;----------------------- C:Plug------------------------------------- 
(defun Plug() 

   
(setq x 0.0 dx 0.0 dy 0.0 ) 

(Sett) 
(command "_zoom" "_all") 

(Input_Fun) 

(if (> bb h) (setq hlit (/ h 2)) 
	(setq hlit b2) 
) 

(Kontur) 
(Abcd) 
(Raschet)  
(setq xvrem (+ delta2 vrem1)) 
(command "_scale" "c" (list xvrem (- alfa2 hk)) 
                    (list (+ delta vrem1) (- alfa hk)) "" 
                     (list xvrem (- alfa2 hk)) 45) 
;(SetLayer "0") 
(command "_line" (list (- 0 (+ bkx 100)) (- 0 b2)) (list (+ 100 x) 
                                                   (- 0 b2)) "") 
(command "_text" (list (- 0 (+ bkx 25)) (- 0 bb)) hlit 0 "y") 
(command "_text" (list x (- 0 bb)) hlit 0 "x") 
(setq x (+ bkx 25 (/ (- vrem1 (+ bkx 25)) 2)) ) 
(command "_line" (list x (+ hp (* 0.75 h))) (list x pointy) "") 
(command "_text" (list (- x hlit) (+ hp (* 0.75 h))) hlit 0 "z") 
(command "_text" (list (- x hlit) pointy) hlit 0 "x") 
(command "_text" (list xvrem pointy) hlit 0 "ѓа дЁЄ Љ‘Ћ") 
;(SetLayer "os") 
(command "_line" (list dx (+ hp (* 0.75 h))) (list dx pointy) "")  
  (command "_ucs" "w") 
  (command "_zoom" "_all") 
  (setvar "CMDECHO" cmde) 
  (setvar "BLIPMODE" blmd) 
(princ "OK") 
(princ) 
)

P.S. если кто может помочь, но безвозмездно это не хочет делать пишите в ЛС, договоримся

[Кулик Алексей aka kpblc]

привязку кто снимать будет? Либо (setvar osmode 0) и потом восстанавливать, либо заменить

Код:

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

(command "_line" (list b1 yvrem) (list b1 sch) "")

на

Код:

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

(command "_line" "_none" (list b1 yvrem) "_none" (list b1 sch) "")

Естественно, замена по всему коду должна пройти.