| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Начиная с 14й версии автокада некорректно работает лисп

Начиная с 14й версии автокада некорректно работает лисп

Ответ
Поиск в этой теме
Непрочитано 19.08.2015, 19:31 #1
Начиная с 14й версии автокада некорректно работает лисп
Kllrnn
 
Регистрация: 19.08.2015
Сообщений: 2

часа два искал похожую тему на форуме, но не нашел.

собственно вопрос таков, начиная с автокада 14 некорректно работает лисп.
лисп использую для подсчета метража арматуры.
для работы нужны несколько динамических блоков. прикрепил к посту файл автокада с блоками.
некорректно работает одна функция лиспа, MTD.
при корректной работе эта фунция должна выдавать эскиз деталей. но с автокада 14 вместо собственно эскизов вылетает окошко где предлагается ручками вводить размеры.
товарищ по работе обходит эту проблему так, устанавливает автокад 13 поверх него автокад 16 и выбирает опцию мигрировать. в таком случае эта фунция работает.
хотелось бы узнать в чем корень проблемы так сказать?
вот лисп.

Код:
[Выделить все]
 
(vl-load-com)

(defun c:BINYAT11 ()
 (print " Program bloklar ile birlikte kullanilir.")
 (print " Demir pozlamasi icin 'POZ', ")
 (print " Demir metraji icin `MTT', ")
 (print " Demir detay cizimi icin 'MTD', ")
 (print " Secilen sayilarin toplamini, secilen yaziya yazmak icin 'TT', ")
 (print " Secilen sayilarin carpimini, secilen yaziya yazmak icin 'CC', ")
 (print " Metraj tablosinda yazi ayari icin: scale 100, yukseklik 25, ")
 (print " Donati Detay tablosinda yazi ayari icin: scale 100, yukseklik 25, ")
 (print " Yardim icin 'BINYAT11' girin.")
 (print " BINYAT TASLAMA... ")
 (princ)
)
;-----------
(defun myerror (s)
 (if (/= s "FUNCTION CANCELLED")
     (princ (strcat "\nError:" s))
 )
 (setq *error* olderr)
 (princ)
)
;----------
(defun dtr (a) (* pi (/ a 180.0)));dereceyi radyana cevirir
(defun rtd (r) (/ (* r 180.0) pi));radyani dereceye

;-------otomatik pozlama --------------------
(defun c:POZ (/ ss ssl n ob demcap demboy ibuk sbuk ob-lis pozlis obje m
               demcap2 demboy2 ibuk2 sbuk2)
 (setq olderr *error*
       *error* myerror)
  ;---- obje secimi---- 
  (setq ss (ssget (list (cons 2 "L-POZ*"))))
  ;(setq ssetr (ssget "P" (list (cons 2 "L-POZE"))))
  (setq ssl (sslength ss))
  ;(if (/= ssetr nil)(progn
  ;    (setq ssletr (sslength ssetr))
  ;    (setq ob (ssname ssetr 0))
  ;    (setq n 0)
  ;---- etriyeleri eleme ----
  ;    (while ob
  ;     (ssdel ob ss)
  ;     (setq n (+ n 1))
  ;     (setq ob (ssname ssetr n))
  ;    )
  ;    (setq ssl (sslength ss))
  ;));if
  ;---- min demir capini bulma
  ; (setq n 0)
  ; (while (< n ssl)
  ;   (setq ob (ssname ss n))
  ;   (setq demcap (atof (cdr(assoc 1(entget (entnext (entnext (entnext ob))))))))
  ;   (if (= n 0)
  ;       (setq mincap demcap)
  ;       (setq mincap (min mincap demcap))
  ;   );for if
  ;   (setq n (+ n 1))
  ; );for while
  ;---- pozlama
   (setq n 0)
   (setq ob (ssname ss n))
   (while (ssname ss 0)
     (setq ob (ssname ss 0))
     (setq blokadi (substr (cdr(assoc 2 (entget ob))) 1 6))

     (setq demcap (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
     (setq demboy (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
     (if (= blokadi "L-POZE")(progn
        (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
        (setq 1yk (cdr(assoc 1 (entget etrl))))
        (setq 2yk (cdr(assoc 1 (entget (entnext etrl)))))
        (setq 1dk (cdr(assoc 1 (entget (entnext (entnext etrl))))))
        (setq 2dk (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
        (setq ibuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
        (setq sbuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
       );progn
       (progn
        (setq ibuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext ob))))))))))
        (setq sbuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext(entnext ob)))))))))))
       );progn
     );if

       (setq ob-lis (entget ob))
       (setq pozlis (entget(entnext ob)))
       (setq obje (subst (cons 1 (rtos(+ n 1)2 0)) (assoc 1 pozlis) pozlis))
       (entmod obje)
       (entupd (cdr (car obje)))
       (ssdel ob ss)
       ;(print "ILK POZ")(princ (+ n 1))
     (setq m 0)
     (while (< m (sslength ss))
            ;(print " M = ")(princ m)
            ;(print " OBJE = ")(princ (sslength ss))
            (setq ob (ssname ss m))
            (setq demcap2 (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
            (setq demboy2 (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
          (if (= blokadi "L-POZE")(progn
            (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
            (setq 1yk2 (cdr(assoc 1 (entget etrl))))
            (setq 2yk2 (cdr(assoc 1 (entget (entnext etrl)))))
            (setq 1dk2 (cdr(assoc 1 (entget (entnext (entnext etrl))))))
            (setq 2dk2 (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
            (setq ibuk2(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
            (setq sbuk2(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
            );progn
            (progn
            (setq ibuk2 (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext ob))))))))))
            (setq sbuk2 (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext(entnext ob)))))))))))
            );progn
           );if
          (if (/= blokadi "L-POZE") (progn
            (if (and (and (= demcap demcap2)(= demboy demboy2))
                     (or (and (= ibuk ibuk2)(= sbuk sbuk2))
                         (and (= ibuk sbuk2)(= sbuk ibuk2))
                     )
                )
                (setq kont "VAR")(setq kont "YOK")
            ));if , progn
            (progn
            (if (and (and (= demcap demcap2)(= demboy demboy2)
                          (= 1yk 1yk2)(= 2yk 2yk2)(= 1dk 1dk2)(= 2dk 2dk2)
                     )
                     (or (and (= ibuk ibuk2)(= sbuk sbuk2))
                         (and (= ibuk sbuk2)(= sbuk ibuk2))
                     )
                )
                (setq kont "VAR")(setq kont "YOK")
            ));if , progn
           );if
      (if (= kont "VAR")
          (progn 
          (setq ob-lis (entget ob))
          (setq pozlis (entget(entnext ob)))
          (setq obje (subst (cons 1 (rtos(+ n 1)2 0)) (assoc 1 pozlis) pozlis))
          (entmod obje)
          (entupd (cdr (car obje)))
          (ssdel ob ss)
          );progn
          (progn
          (setq m (+ m 1))
          )
       )
     );while
     (setq n (+ n 1))
   );for while
   (princ "Son poz ")(princ n)(setq sonpoz n)
   (setq *error* olderr)
   (princ)
);for defun
;-------
;-------demir pozlarina gore metraj--------------------
(defun c:MTT (/ liste dliste kontrol olderr ss ssl n ob pozno pozson sayim m var dadtop demad demcap
                demboy basnok yazyuk bascap1 basdad basboy topboy bascap bassek
                cizolc1 basolc demecap demeboy cinok ss1 ss2 ibuk sbuk)
 (setq olderr *error*
       *error* myerror)
 ;(setq liste nil)
 ;(setq dliste nil)
 (setq or-os (getvar "OSMODE"))
 (setvar "osmode" 0)
 ;---olcek kontrolu---
    (if (= cizolc nil) (progn (initget 1)(setq cizolc (getreal "\nCizim cikti olcegi? :")))
                      (progn
                      (princ (strcat "\nCizim cikti olcegi? <1/" (rtos cizolc 2 1)"> : "))
                      (setq cizolc1  (getreal ))
                      (if (or (= cizolc1 nil)(= cizolc1 ""))
                          (setq cizolc cizolc)
                          (setq cizolc cizolc1)
                      );for if
                      );for progn
    );for if
   (setq basolc (/ cizolc 100))
  ;---metraj secimi---- 
  (setq ss (ssget (list (cons 2 "L-POZ*"))))
   (setq ssl (sslength ss))
   (setq n 0)
   (while (< n ssl)
     (setq ob (ssname ss n))
     (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
     (if (= n 0)
         (setq pozson pozno)
         (setq pozson (max pozson pozno))
     );for if
     (setq n (+ n 1))
   );for while
   (print (strcat "Son poz numarasi : " (rtos pozson 2 0)))
   (princ)
   (setq n 0)
   ;-----
   (setq sayim (max ssl pozson))
   (while (< n sayim)
     (setq m 0)
     (setq var nil)
     (setq dadtop 0)
     (while (< m sayim)
       (setq ob (ssname ss m))

       (if (/= ob nil) (progn
        (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
        (setq blokadi (substr (cdr (assoc 2 (entget ob))) 1 6))
         (if (= pozno (+ n 1))
            (progn
             (setq demad (cdr(assoc 1 (entget (entnext (entnext ob))))))
             (setq demcap (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
             (setq demboy (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
             (setq ibuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext ob))))))))))
             (setq sbuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext(entnext ob)))))))))))
             (if (= blokadi "L-POZE")(progn
               (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
               (setq 1yk (cdr(assoc 1 (entget etrl))))
               (setq 2yk (cdr(assoc 1 (entget (entnext etrl)))))
               (setq 1dk (cdr(assoc 1 (entget (entnext (entnext etrl))))))
               (setq 2dk (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
               (setq ibuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
               (setq sbuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
             ));progn ,if
              ;bu bolum otomatik pozlama yapildigi icin iptal edildi.
              ;-----onceki poz ile kontrol
              ;(if (assoc pozno dliste) (progn
              ; (setq demecap (nth 2 (assoc pozno dliste)))
              ; (setq demeboy (nth 3 (assoc pozno dliste)))
              ; (if (or (/= demcap demecap) (/= demboy demeboy))
              ;     (progn
              ;     (setq cinok (cdr (assoc 10(entget ob))))
              ;     (command "circle" cinok 60)
              ;     (command "zoom" "c" cinok 800)
              ;     (setq kontrol "HATA" m sayim n sayim)
              ;     (print "Ekranda isaretli gorulen poz, diger ayni pozla uyumlu degil.!!!")
              ;     (print "Islem iptal edildi.Hata duzeltilip, program yeniden calistirilmali.")
              ;     );for progn
              ; );for if
              ;));for if and progn
              ;----------

             (setq dadtop (+ dadtop (atoi demad)))
             (setq var "VAR")
             (if (= blokadi "L-POZE")
              (setq dliste (list (list pozno "ETRIYE" dadtop demcap demboy 1yk 2yk 1dk 2dk ibuk sbuk)))
              (setq dliste (list (list pozno "DEMIR" dadtop demcap demboy ibuk sbuk)))
             );if
       ))));for progn and if
       (setq m (+ m 1))
     );for while
     (if (= var "VAR")
         (setq liste (append liste dliste))
         (if (< (+ n 1) pozson) (print (strcat (rtos (+ n 1) 2 0) ". poz kullanilmamis!")))
     );for if
    (setq n (+ n 1))
   );while
   (princ)

(if (/= kontrol "HATA") (progn
   ;------metrajin yazimi
   ;------metraj yazimi icin kullanilan format
   ;pozno  cap  adet boy sekil 8   10 12 14 16 18 20 22 26 30 diger
   ;  80   120  120  140 380  120 ..........................120 br.
   ;satir aralari=70 br.
   (command "layer" "M" "_BN_Text_Metraj" "")
   (setq basnok (getpoint "\nMetrajin yazimi icin pozno hucresinin sag alt noktasi? :"))
   (setq basnok (polar basnok (dtr 180) (* basolc 40)))
   (setq basnok (polar basnok (dtr 90) (* basolc 20)))
   (setq yazyuk (getreal "\nYazi yukseligi <25>: "))
   (if (= yazyuk nil) (setq yazyuk 25))
   (setq sayim (length liste))
   (setq n 0)
   (while (< n sayim)
       (setq pozno (rtos (nth 0(nth n liste)) 2 0))
       (setq tip (nth 1(nth n liste)))------------
       (setq dadtop (rtos (nth 2(nth n liste)) 2 0))
       (setq demcap (nth 3(nth n liste)))
       (setq demboy (nth 4(nth n liste)))
       (cond ((= tip "DEMIR")
              (setq ibuk (nth 5(nth n liste)))
              (setq sbuk (nth 6(nth n liste)))
             )
             ((= tip "ETRIYE")
              (setq 1yk (nth 5(nth n liste)))
              (setq 2yk (nth 6(nth n liste)))
              (setq 1dk (nth 7(nth n liste)))
              (setq 2dk (nth 8(nth n liste)))
              (setq ibuk (nth 9(nth n liste)))
              (setq sbuk (nth 10(nth n liste)))
             )
       );cond
       ;---yazi baslangic noktalari
       (setq yazitds1 (polar basnok 0 (* basolc 440)))
       (setq yazitds "TDS 5781-82*")
       (setq yazifi1 (polar basnok 0 (* basolc 680)))
       (setq yazifi "%%C")
       (setq bascap1 (polar basnok 0 (* basolc 715)))
       (setq yaziai1 (polar basnok 0 (* basolc 765)))  
       (setq yazilen1 (polar basnok 0 (* basolc 1190)))
       (setq yazilen "L=")       
       (setq basboy (polar basnok 0 (* basolc 1260)))
       (setq basdad (polar basnok 0 (* basolc 1370)))       
       (setq birimagr1 (polar basnok 0 (* basolc 1510)))       
       (setq birimagr (rtos (/ (* (atoi demboy) (* (atoi demcap) (* (atoi demcap) 0.00617))) 100.0) 2 2))
       (setq topboy (rtos (/ (* (atoi dadtop) (* (atoi demboy) (* (atoi demcap) (* (atoi demcap) 0.00617)))) 100.0) 2 2))  
       (setq bassek (polar basboy 0 (* basolc 900))) 
       (if (/= (atoi demcap) 32) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 8) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 10) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 12) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 14) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 16) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 18) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 20) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 22) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 24) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 25) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 26) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 28) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 30) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 32) (setq bascap (polar basnok 0 (* basolc 1700))))
       (setq demcap11 demcap)
       (setq yaziai (if (<= (atoi demcap11) 8) (setq demcap11 "AI") (setq demcap11 "AIII")))       
       (command "text" "j" "c" basnok yazyuk 0 pozno
                "text" "j" "r" bascap1 yazyuk 0 demcap
		"text" "j" "r" yazitds1 yazyuk 0 yazitds
		"text" "j" "r" yazifi1 yazyuk 0 yazifi
		"text" "j" "r" yaziai1 yazyuk 0 yaziai
                "text" "j" "r" basdad yazyuk 0 dadtop
		"text" "j" "r" yazilen1 yazyuk 0 yazilen
                "text" "j" "r" basboy yazyuk 0 demboy
                "text" "j" "r" bascap yazyuk 0 topboy
		"text" "j" "r" birimagr1 yazyuk 0 birimagr)
    

       (setq basnok (polar basnok (dtr 270) (* basolc 80)))
       (setq n (+ n 1))
   );for while
 ));for if and progn
;   (setq *error* olderr)
   (setvar "osmode" or-os)
   (princ)
)
(defun c:MTD (/ liste dliste kontrol olderr ss ssl n ob pozno pozson sayim m var dadtop demad demcap
                demboy basnok yazyuk bascap1 basdad basboy topboy bascap bassek
                cizolc1 basolc demecap demeboy cinok ss1 ss2 ibuk sbuk)
 (setq olderr *error*
       *error* myerror)
 ;(setq liste nil)
 ;(setq dliste nil)
 (setq or-os (getvar "OSMODE"))
 (setvar "osmode" 0)
 ;---olcek kontrolu---
    (if (= cizolc nil) (progn (initget 1)(setq cizolc (getreal "\nCizim cikti olcegi? :")))
                      (progn
                      (princ (strcat "\nCizim cikti olcegi? <1/" (rtos cizolc 2 1)"> : "))
                      (setq cizolc1  (getreal ))
                      (if (or (= cizolc1 nil)(= cizolc1 ""))
                          (setq cizolc cizolc)
                          (setq cizolc cizolc1)
                      );for if
                      );for progn
    );for if
   (setq basolc (/ cizolc 100))
  ;---metraj secimi---- 
  (setq ss (ssget (list (cons 2 "L-POZ*"))))
   (setq ssl (sslength ss))
   (setq n 0)
   (while (< n ssl)
     (setq ob (ssname ss n))
     (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
     (if (= n 0)
         (setq pozson pozno)
         (setq pozson (max pozson pozno))
     );for if
     (setq n (+ n 1))
   );for while
   (print (strcat "Son poz numarasi : " (rtos pozson 2 0)))
   (princ)
   (setq n 0)
   ;-----
   (setq sayim (max ssl pozson))
   (while (< n sayim)
     (setq m 0)
     (setq var nil)
     (setq dadtop 0)
     (while (< m sayim)
       (setq ob (ssname ss m))

       (if (/= ob nil) (progn
        (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
        (setq blokadi (substr (cdr (assoc 2 (entget ob))) 1 6))
         (if (= pozno (+ n 1))
            (progn
             (setq demad (cdr(assoc 1 (entget (entnext (entnext ob))))))
             (setq demcap (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
             (setq demboy (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
             (setq ibuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext ob))))))))))
             (setq sbuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext(entnext ob)))))))))))
             (if (= blokadi "L-POZE")(progn
               (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
               (setq 1yk (cdr(assoc 1 (entget etrl))))
               (setq 2yk (cdr(assoc 1 (entget (entnext etrl)))))
               (setq 1dk (cdr(assoc 1 (entget (entnext (entnext etrl))))))
               (setq 2dk (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
               (setq ibuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
               (setq sbuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
             ));progn ,if
              ;bu bolum otomatik pozlama yapildigi icin iptal edildi.
              ;-----onceki poz ile kontrol
              ;(if (assoc pozno dliste) (progn
              ; (setq demecap (nth 2 (assoc pozno dliste)))
              ; (setq demeboy (nth 3 (assoc pozno dliste)))
              ; (if (or (/= demcap demecap) (/= demboy demeboy))
              ;     (progn
              ;     (setq cinok (cdr (assoc 10(entget ob))))
              ;     (command "circle" cinok 60)
              ;     (command "zoom" "c" cinok 800)
              ;     (setq kontrol "HATA" m sayim n sayim)
              ;     (print "Ekranda isaretli gorulen poz, diger ayni pozla uyumlu degil.!!!")
              ;     (print "Islem iptal edildi.Hata duzeltilip, program yeniden calistirilmali.")
              ;     );for progn
              ; );for if
              ;));for if and progn
              ;----------

             (setq dadtop (+ dadtop (atoi demad)))
             (setq var "VAR")
             (if (= blokadi "L-POZE")
              (setq dliste (list (list pozno "ETRIYE" dadtop demcap demboy 1yk 2yk 1dk 2dk ibuk sbuk)))
              (setq dliste (list (list pozno "DEMIR" dadtop demcap demboy ibuk sbuk)))
             );if
       ))));for progn and if
       (setq m (+ m 1))
     );for while
     (if (= var "VAR")
         (setq liste (append liste dliste))
         (if (< (+ n 1) pozson) (print (strcat (rtos (+ n 1) 2 0) ". poz kullanilmamis!")))
     );for if
    (setq n (+ n 1))
   );while
   (princ)

(if (/= kontrol "HATA") (progn
   ;------metrajin yazimi
   ;------metraj yazimi icin kullanilan format
   ;pozno  cap  adet boy sekil 8   10 12 14 16 18 20 22 26 30 diger
   ;  80   120  120  140 380  120 ..........................120 br.
   ;satir aralari=64 br.
   (command "layer" "M" "_BN_Text_Metraj" "")
   (setq basnok (getpoint "\nMetrajin yazimi icin pozno hucresinin sag alt noktasi? :"))
   (setq basnok (polar basnok (dtr 180) (* basolc 40)))
   (setq basnok (polar basnok (dtr 90) (* basolc 20)))
   (setq yazyuk (getreal "\nYazi yukseligi <25>: "))
   (if (= yazyuk nil) (setq yazyuk 25))
   (setq sayim (length liste))
   (setq n 0)
   (while (< n sayim)
       (setq pozno (rtos (nth 0(nth n liste)) 2 0))
       (setq tip (nth 1(nth n liste)))------------
       (setq dadtop (rtos (nth 2(nth n liste)) 2 0))
       (setq demcap (nth 3(nth n liste)))
       (setq demboy (nth 4(nth n liste)))
       (cond ((= tip "DEMIR")
              (setq ibuk (nth 5(nth n liste)))
              (setq sbuk (nth 6(nth n liste)))
             )
             ((= tip "ETRIYE")
              (setq 1yk (nth 5(nth n liste)))
              (setq 2yk (nth 6(nth n liste)))
              (setq 1dk (nth 7(nth n liste)))
              (setq 2dk (nth 8(nth n liste)))
              (setq ibuk (nth 9(nth n liste)))
              (setq sbuk (nth 10(nth n liste)))
             )
       );cond
       ;---yazi baslangic noktalari
               
       (setq bassek (polar basnok 0 (* basolc 350)))     
       (command "text" "j" "c" basnok yazyuk 0 pozno)	   
     
     (cond ((= tip "DEMIR")
       (cond ((and (= ibuk "0")(= sbuk "0"))(command "insert" "DEM-DUZ" bassek basolc basolc 0 demboy))
             ((and (/= ibuk "0")(/= sbuk "0"))
              (setq demboy (rtos (- (atof demboy)(atof ibuk)(atof sbuk))2 0))
              (command "insert" "DEM-2" bassek basolc basolc 0 demboy ibuk sbuk)
             )
             ((and (= ibuk "0")(/= sbuk "0"))
              (setq demboy (rtos (- (atof demboy)(atof sbuk))2 0))
              (command "insert" "DEM-1" bassek basolc basolc 0 demboy sbuk)
             )
             ((and (/= ibuk "0")(= sbuk "0"))
              (setq demboy (rtos (- (atof demboy)(atof ibuk))2 0))
              (command "insert" "DEM-1" bassek basolc basolc 0 demboy ibuk)
             )
       );cond
       )
      ((= tip "ETRIYE")
       (command "insert" "DEM-E" bassek basolc basolc 0 1yk 2yk 1dk 2dk ibuk sbuk)
      )
     );cond


       (setq basnok (polar basnok (dtr 270) (* basolc 160)))
       (setq n (+ n 1))
   );for while
 ));for if and progn
;   (setq *error* olderr)
   (setvar "osmode" or-os)
   (princ)
);for defun

; --- TT ve CC in alt programi 
(defun yazdeg (son obje / eslis eski delis)
     (setq eslis (entget (car obje)))
     (setq eski (assoc 1 (entget (car obje))))
     (setq delis (subst son eski eslis))
     (entmod delis)
     (princ)
)
; --- Secilen sayilarin toplamini, secilen yaziya yazar
(defun c:TT (/ son obje ss n son lll na say te) 
   (setq ss (ssget) n 0 son 0 lll nil)
   (setq na (ssname ss n))
   (while na
       (setq te (cdr (assoc 0 (entget na))))
       (if (= te "TEXT") (progn
        (setq say (cdr(assoc 1(entget na))))
        (setq son (+ son (atof say)))
        (setq lll (cons (atof say) lll))
       ));if and progn
        (setq n (+ 1 n))
        (setq na (ssname ss n))
   ) ;while
   (princ (strcat "\nToplam: " (rtos son 2 3))) (princ)
   (princ)
   (setq obje (entsel "\nToplamin yazilacagi yaziyi secin :"))
   (setq te (cdr (assoc 0 (entget (car obje)))))
   (setq son (cons 1 (rtos son 2 2)))
   (if (= te "TEXT") (yazdeg son obje) (print "\nTEXT degil"))
   (princ)
) ;defun
; --- Secilen sayilarin carpimini, secilen yaziya yazar
(defun c:CC (/ son obje ss n son lll na say te) 
   (setq ss (ssget) n 0 son 1 lll nil)
   (setq na (ssname ss n))
   (while na
       (setq te (cdr (assoc 0 (entget na))))
      (if (= te "TEXT") (progn
       (setq say (cdr(assoc 1(entget na))))
       (setq son (* son (atof say)))
       (setq lll (cons (atof say) lll))
      ));if and progn
       (setq n (+ 1 n))
       (setq na (ssname ss n))
   ) ;while
   (princ (strcat "\nCarpim : " (rtos son 2 3))) (princ)
   (princ)
   (setq obje (entsel "\nCarpimin yazilacagi yaziyi secin :"))
   (setq te (cdr (assoc 0 (entget (car obje)))))
   (setq son (cons 1 (rtos son 2 2)))
   (if (= te "TEXT") (yazdeg son obje) (print "\nTEXT degil"))
   (princ)
) ;defun
;-------------------------------------------------------
(print " Produced by *Owezgeldi Yslamow* tm ")
(print " Program bloklar ile birlikte kullanilir.")
(print " Demir pozlamasi icin 'POZ', ")
(print " Demir metraji icin `MTT', ")
(print " Demir detay cizimi icin 'MTD', ")
(print " Secilen sayilarin toplamini, secilen yaziya yazmak icin 'TT', ")
(print " Secilen sayilarin carpimini, secilen yaziya yazmak icin 'CC', ")
(print " Yardim icin 'BINYAT11' girin.")
(print " BINYAT TASLAMA... ")
(grtext -1 "BINYAT")
(princ)

Вложения
Тип файла: dwg
DWG 2007
Drawing2.dwg (172.4 Кб, 534 просмотров)

Просмотров: 3163
 
Непрочитано 19.08.2015, 22:48
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Сообщения и запросы хотя бы на английский переведи - далеко не все понимают показанные тексты.

----- добавлено через 39 сек. -----
Заодно: "автокад 14" - это AutoCAD R14?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.08.2015, 10:39
#3
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,002


Открыть код в редакторе visual lisp, поставить в меню "Отладка" галки на "Команда трассировки"и "Остановить" и прогнать лисп)

А так в строке 348 функции MTD вижу "(if (= cizolc nil)". И после этого, если переменная cizolc=nil, то пошли запросы. В приведенном куске кода этой переменной cizolc по поиску нет - ищите, где она.. Наскольку помню, в лиспе первый раз глобально объявленная переменная как раз nil до инициализации с помощью setq.
Сергей812 вне форума  
 
Автор темы   Непрочитано 20.08.2015, 11:14
#4
Kllrnn


 
Регистрация: 19.08.2015
Сообщений: 2


Алексей, Autocad 2014 и Autocad 2016 на английском.

в лиспе перевел текст с турецкого который имеет хоть какой то смысл.

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

Сергей, спасибо, но я совсем не разбираюсь в этом)

Код:
[Выделить все]
 (vl-load-com)
(defun c:BINYAT11 ()
 (print " Программа работает с блоками")
 (print " Для нумерации блоков армирования команда 'POZ', ")
 (print " Для вывода метража арматуры команда `MTT', ")
 (print " Для вывода эскиза деталей арматуры команда 'MTD', ")
 (print " Для вывода суммы выделенных чисел в выделенный текст команда 'TT', ")
 (print " Для вывода произведения выделенных чисел в выделенный текст команда 'CC', ")
 (print " Выбрать настройку текста в метраже арматуры: масштаб 100, высота 25, ")
 (print " Выбрать настройку для эскиза деталей арматуры: масштаб 100, высота 25, ")
 (print " Для вывода справки команда 'BINYAT11'. ")
(princ)
)
;-----------
(defun myerror (s)
 (if (/= s "FUNCTION CANCELLED")
     (princ (strcat "\nError:" s))
 )
 (setq *error* olderr)
 (princ)
)
;----------
(defun dtr (a) (* pi (/ a 180.0)));переводит градус в радиан
(defun rtd (r) (/ (* r 180.0) pi));радиан в градус

;-------автоматическая нумерация блоков армирования --------------------
(defun c:POZ (/ ss ssl n ob demcap demboy ibuk sbuk ob-lis pozlis obje m
               demcap2 demboy2 ibuk2 sbuk2)
 (setq olderr *error*
       *error* myerror)
  ;---- выбор блоков---- 
  (setq ss (ssget (list (cons 2 "L-POZ*"))))
  ;(setq ssetr (ssget "P" (list (cons 2 "L-POZE"))))
  (setq ssl (sslength ss))
  ;(if (/= ssetr nil)(progn
  ;    (setq ssletr (sslength ssetr))
  ;    (setq ob (ssname ssetr 0))
  ;    (setq n 0)
  ;---- убрать хомуты ----
  ;    (while ob
  ;     (ssdel ob ss)
  ;     (setq n (+ n 1))
  ;     (setq ob (ssname ssetr n))
  ;    )
  ;    (setq ssl (sslength ss))
  ;));if
  ;---- найти минимальный диаметр арматуры
  ; (setq n 0)
  ; (while (< n ssl)
  ;   (setq ob (ssname ss n))
  ;   (setq demcap (atof (cdr(assoc 1(entget (entnext (entnext (entnext ob))))))))
  ;   (if (= n 0)
  ;       (setq mincap demcap)
  ;       (setq mincap (min mincap demcap))
  ;   );for if
  ;   (setq n (+ n 1))
  ; );for while
  ;---- нумерация
   (setq n 0)
   (setq ob (ssname ss n))
   (while (ssname ss 0)
     (setq ob (ssname ss 0))
     (setq blokadi (substr (cdr(assoc 2 (entget ob))) 1 6))

     (setq demcap (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
     (setq demboy (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
     (if (= blokadi "L-POZE")(progn
        (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
        (setq 1yk (cdr(assoc 1 (entget etrl))))
        (setq 2yk (cdr(assoc 1 (entget (entnext etrl)))))
        (setq 1dk (cdr(assoc 1 (entget (entnext (entnext etrl))))))
        (setq 2dk (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
        (setq ibuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
        (setq sbuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
       );progn
       (progn
        (setq ibuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext ob))))))))))
        (setq sbuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext(entnext ob)))))))))))
       );progn
     );if

       (setq ob-lis (entget ob))
       (setq pozlis (entget(entnext ob)))
       (setq obje (subst (cons 1 (rtos(+ n 1)2 0)) (assoc 1 pozlis) pozlis))
       (entmod obje)
       (entupd (cdr (car obje)))
       (ssdel ob ss)
       ;(print "Первая позиция")(princ (+ n 1))
     (setq m 0)
     (while (< m (sslength ss))
            ;(print " M = ")(princ m)
            ;(print " OBJE = ")(princ (sslength ss))
            (setq ob (ssname ss m))
            (setq demcap2 (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
            (setq demboy2 (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
          (if (= blokadi "L-POZE")(progn
            (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
            (setq 1yk2 (cdr(assoc 1 (entget etrl))))
            (setq 2yk2 (cdr(assoc 1 (entget (entnext etrl)))))
            (setq 1dk2 (cdr(assoc 1 (entget (entnext (entnext etrl))))))
            (setq 2dk2 (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
            (setq ibuk2(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
            (setq sbuk2(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
            );progn
            (progn
            (setq ibuk2 (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext ob))))))))))
            (setq sbuk2 (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext (entnext(entnext ob)))))))))))
            );progn
           );if
          (if (/= blokadi "L-POZE") (progn
            (if (and (and (= demcap demcap2)(= demboy demboy2))
                     (or (and (= ibuk ibuk2)(= sbuk sbuk2))
                         (and (= ibuk sbuk2)(= sbuk ibuk2))
                     )
                )
                (setq kont "VAR")(setq kont "YOK")
            ));if , progn
            (progn
            (if (and (and (= demcap demcap2)(= demboy demboy2)
                          (= 1yk 1yk2)(= 2yk 2yk2)(= 1dk 1dk2)(= 2dk 2dk2)
                     )
                     (or (and (= ibuk ibuk2)(= sbuk sbuk2))
                         (and (= ibuk sbuk2)(= sbuk ibuk2))
                     )
                )
                (setq kont "VAR")(setq kont "YOK")
            ));if , progn
           );if
      (if (= kont "VAR")
          (progn 
          (setq ob-lis (entget ob))
          (setq pozlis (entget(entnext ob)))
          (setq obje (subst (cons 1 (rtos(+ n 1)2 0)) (assoc 1 pozlis) pozlis))
          (entmod obje)
          (entupd (cdr (car obje)))
          (ssdel ob ss)
          );progn
          (progn
          (setq m (+ m 1))
          )
       )
     );while
     (setq n (+ n 1))
   );for while
   (princ "Последняя позиция ")(princ n)(setq sonpoz n)
   (setq *error* olderr)
   (princ)
);for defun
;-------
;-------Метраж позиций--------------------
(defun c:MTT (/ liste dliste kontrol olderr ss ssl n ob pozno pozson sayim m var dadtop demad demcap
                demboy basnok yazyuk bascap1 basdad basboy topboy bascap bassek
                cizolc1 basolc demecap demeboy cinok ss1 ss2 ibuk sbuk)
 (setq olderr *error*
       *error* myerror)
 ;(setq liste nil)
 ;(setq dliste nil)
 (setq or-os (getvar "OSMODE"))
 (setvar "osmode" 0)
 ;---контроль масштаба---
    (if (= cizolc nil) (progn (initget 1)(setq cizolc (getreal "\nМасштаб выведенного рисунка? :")))
                      (progn
                      (princ (strcat "\nМасштаб выведенного рисунка? <1/" (rtos cizolc 2 1)"> : "))
                      (setq cizolc1  (getreal ))
                      (if (or (= cizolc1 nil)(= cizolc1 ""))
                          (setq cizolc cizolc)
                          (setq cizolc cizolc1)
                      );for if
                      );for progn
    );for if
   (setq basolc (/ cizolc 100))
  ;---выбор метража---- 
  (setq ss (ssget (list (cons 2 "L-POZ*"))))
   (setq ssl (sslength ss))
   (setq n 0)
   (while (< n ssl)
     (setq ob (ssname ss n))
     (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
     (if (= n 0)
         (setq pozson pozno)
         (setq pozson (max pozson pozno))
     );for if
     (setq n (+ n 1))
   );for while
   (print (strcat "номер последней позиции : " (rtos pozson 2 0)))
   (princ)
   (setq n 0)
   ;-----
   (setq sayim (max ssl pozson))
   (while (< n sayim)
     (setq m 0)
     (setq var nil)
     (setq dadtop 0)
     (while (< m sayim)
       (setq ob (ssname ss m))

       (if (/= ob nil) (progn
        (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
        (setq blokadi (substr (cdr (assoc 2 (entget ob))) 1 6))
         (if (= pozno (+ n 1))
            (progn
             (setq demad (cdr(assoc 1 (entget (entnext (entnext ob))))))
             (setq demcap (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
             (setq demboy (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
             (setq ibuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext ob))))))))))
             (setq sbuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext(entnext ob)))))))))))
             (if (= blokadi "L-POZE")(progn
               (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
               (setq 1yk (cdr(assoc 1 (entget etrl))))
               (setq 2yk (cdr(assoc 1 (entget (entnext etrl)))))
               (setq 1dk (cdr(assoc 1 (entget (entnext (entnext etrl))))))
               (setq 2dk (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
               (setq ibuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
               (setq sbuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
             ));progn ,if
             (setq dadtop (+ dadtop (atoi demad)))
             (setq var "VAR")
             (if (= blokadi "L-POZE")
              (setq dliste (list (list pozno "ETRIYE" dadtop demcap demboy 1yk 2yk 1dk 2dk ibuk sbuk)))
              (setq dliste (list (list pozno "DEMIR" dadtop demcap demboy ibuk sbuk)))
             );if
       ))));for progn and if
       (setq m (+ m 1))
     );for while
     (if (= var "VAR")
         (setq liste (append liste dliste))
         (if (< (+ n 1) pozson) (print (strcat (rtos (+ n 1) 2 0) ". poz kullanilmamis!")))
     );for if
    (setq n (+ n 1))
   );while
   (princ)

(if (/= kontrol "HATA") (progn
   ;------вывод метража
   ;------использованный формат для вывода метража
   ;pozno  cap  adet boy sekil 8   10 12 14 16 18 20 22 26 30 diger
   ;  80   120  120  140 380  120 ..........................120 br.
   ;satir aralari=70 br.
   (command "layer" "M" "_BN_Text_Metraj" "")
   (setq basnok (getpoint "\nПравая нижняя точка клетки номера позиции для вывода метража? :"))
   (setq basnok (polar basnok (dtr 180) (* basolc 40)))
   (setq basnok (polar basnok (dtr 90) (* basolc 20)))
   (setq yazyuk (getreal "\nYazi yukseligi <25>: "))
   (if (= yazyuk nil) (setq yazyuk 25))
   (setq sayim (length liste))
   (setq n 0)
   (while (< n sayim)
       (setq pozno (rtos (nth 0(nth n liste)) 2 0))
       (setq tip (nth 1(nth n liste)))------------
       (setq dadtop (rtos (nth 2(nth n liste)) 2 0))
       (setq demcap (nth 3(nth n liste)))
       (setq demboy (nth 4(nth n liste)))
       (cond ((= tip "DEMIR")
              (setq ibuk (nth 5(nth n liste)))
              (setq sbuk (nth 6(nth n liste)))
             )
             ((= tip "ETRIYE")
              (setq 1yk (nth 5(nth n liste)))
              (setq 2yk (nth 6(nth n liste)))
              (setq 1dk (nth 7(nth n liste)))
              (setq 2dk (nth 8(nth n liste)))
              (setq ibuk (nth 9(nth n liste)))
              (setq sbuk (nth 10(nth n liste)))
             )
       );cond
       ;---начальные точки текста
       (setq yazitds1 (polar basnok 0 (* basolc 440)))
       (setq yazitds "TDS 5781-82*")
       (setq yazifi1 (polar basnok 0 (* basolc 680)))
       (setq yazifi "%%C")
       (setq bascap1 (polar basnok 0 (* basolc 715)))
       (setq yaziai1 (polar basnok 0 (* basolc 765)))  
       (setq yazilen1 (polar basnok 0 (* basolc 1190)))
       (setq yazilen "L=")       
       (setq basboy (polar basnok 0 (* basolc 1260)))
       (setq basdad (polar basnok 0 (* basolc 1370)))       
       (setq birimagr1 (polar basnok 0 (* basolc 1510)))       
       (setq birimagr (rtos (/ (* (atoi demboy) (* (atoi demcap) (* (atoi demcap) 0.00617))) 100.0) 2 2))
       (setq topboy (rtos (/ (* (atoi dadtop) (* (atoi demboy) (* (atoi demcap) (* (atoi demcap) 0.00617)))) 100.0) 2 2))  
       (setq bassek (polar basboy 0 (* basolc 900))) 
       (if (/= (atoi demcap) 32) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 8) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 10) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 12) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 14) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 16) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 18) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 20) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 22) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 24) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 25) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 26) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 28) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 30) (setq bascap (polar basnok 0 (* basolc 1700))))
       (if (= (atoi demcap) 32) (setq bascap (polar basnok 0 (* basolc 1700))))
       (setq demcap11 demcap)
       (setq yaziai (if (<= (atoi demcap11) 8) (setq demcap11 "AI") (setq demcap11 "AIII")))       
       (command "text" "j" "c" basnok yazyuk 0 pozno
                "text" "j" "r" bascap1 yazyuk 0 demcap
		"text" "j" "r" yazitds1 yazyuk 0 yazitds
		"text" "j" "r" yazifi1 yazyuk 0 yazifi
		"text" "j" "r" yaziai1 yazyuk 0 yaziai
                "text" "j" "r" basdad yazyuk 0 dadtop
		"text" "j" "r" yazilen1 yazyuk 0 yazilen
                "text" "j" "r" basboy yazyuk 0 demboy
                "text" "j" "r" bascap yazyuk 0 topboy
		"text" "j" "r" birimagr1 yazyuk 0 birimagr)
    

       (setq basnok (polar basnok (dtr 270) (* basolc 80)))
       (setq n (+ n 1))
   );for while
 ));for if and progn
;   (setq *error* olderr)
   (setvar "osmode" or-os)
   (princ)
)
(defun c:MTD (/ liste dliste kontrol olderr ss ssl n ob pozno pozson sayim m var dadtop demad demcap
                demboy basnok yazyuk bascap1 basdad basboy topboy bascap bassek
                cizolc1 basolc demecap demeboy cinok ss1 ss2 ibuk sbuk)
 (setq olderr *error*
       *error* myerror)
 ;(setq liste nil)
 ;(setq dliste nil)
 (setq or-os (getvar "OSMODE"))
 (setvar "osmode" 0)
 ;---контроль масштаба---
    (if (= cizolc nil) (progn (initget 1)(setq cizolc (getreal "\nМасштаб выведеного рисунка? :")))
                      (progn
                      (princ (strcat "\nМасштаб выведеного рисунка? <1/" (rtos cizolc 2 1)"> : "))
                      (setq cizolc1  (getreal ))
                      (if (or (= cizolc1 nil)(= cizolc1 ""))
                          (setq cizolc cizolc)
                          (setq cizolc cizolc1)
                      );for if
                      );for progn
    );for if
   (setq basolc (/ cizolc 100))
  ;---metraj secimi---- 
  (setq ss (ssget (list (cons 2 "L-POZ*"))))
   (setq ssl (sslength ss))
   (setq n 0)
   (while (< n ssl)
     (setq ob (ssname ss n))
     (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
     (if (= n 0)
         (setq pozson pozno)
         (setq pozson (max pozson pozno))
     );for if
     (setq n (+ n 1))
   );for while
   (print (strcat "Номер последней позиции: " (rtos pozson 2 0)))
   (princ)
   (setq n 0)
   ;-----
   (setq sayim (max ssl pozson))
   (while (< n sayim)
     (setq m 0)
     (setq var nil)
     (setq dadtop 0)
     (while (< m sayim)
       (setq ob (ssname ss m))

       (if (/= ob nil) (progn
        (setq pozno (atoi (cdr(assoc 1 (entget (entnext ob))))))
        (setq blokadi (substr (cdr (assoc 2 (entget ob))) 1 6))
         (if (= pozno (+ n 1))
            (progn
             (setq demad (cdr(assoc 1 (entget (entnext (entnext ob))))))
             (setq demcap (cdr(assoc 1(entget (entnext (entnext (entnext ob)))))))
             (setq demboy (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext ob)))))))))
             (setq ibuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext ob))))))))))
             (setq sbuk (cdr(assoc 1(entget (entnext (entnext (entnext (entnext (entnext(entnext(entnext ob)))))))))))
             (if (= blokadi "L-POZE")(progn
               (setq etrl (entnext(entnext (entnext (entnext (entnext (entnext ob)))))))
               (setq 1yk (cdr(assoc 1 (entget etrl))))
               (setq 2yk (cdr(assoc 1 (entget (entnext etrl)))))
               (setq 1dk (cdr(assoc 1 (entget (entnext (entnext etrl))))))
               (setq 2dk (cdr(assoc 1 (entget (entnext (entnext (entnext etrl)))))))
               (setq ibuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext etrl))))))))
               (setq sbuk(cdr(assoc 1 (entget (entnext (entnext (entnext (entnext (entnext etrl)))))))))
             ));progn ,if
             (setq dadtop (+ dadtop (atoi demad)))
             (setq var "VAR")
             (if (= blokadi "L-POZE")
              (setq dliste (list (list pozno "ETRIYE" dadtop demcap demboy 1yk 2yk 1dk 2dk ibuk sbuk)))
              (setq dliste (list (list pozno "DEMIR" dadtop demcap demboy ibuk sbuk)))
             );if
       ))));for progn and if
       (setq m (+ m 1))
     );for while
     (if (= var "VAR")
         (setq liste (append liste dliste))
         (if (< (+ n 1) pozson) (print (strcat (rtos (+ n 1) 2 0) ". poz kullanilmamis!")))
     );for if
    (setq n (+ n 1))
   );while
   (princ)

(if (/= kontrol "HATA") (progn
   ;------вывод метража
   ;------формат использованный для вывода метража
   ;pozno  cap  adet boy sekil 8   10 12 14 16 18 20 22 26 30 diger
   ;  80   120  120  140 380  120 ..........................120 br.
   ;satir aralari=64 br.
   (command "layer" "M" "_BN_Text_Metraj" "")
   (setq basnok (getpoint "\nMetrajin yazimi icin pozno hucresinin sag alt noktasi? :"))
   (setq basnok (polar basnok (dtr 180) (* basolc 40)))
   (setq basnok (polar basnok (dtr 90) (* basolc 20)))
   (setq yazyuk (getreal "\nYazi yukseligi <25>: "))
   (if (= yazyuk nil) (setq yazyuk 25))
   (setq sayim (length liste))
   (setq n 0)
   (while (< n sayim)
       (setq pozno (rtos (nth 0(nth n liste)) 2 0))
       (setq tip (nth 1(nth n liste)))------------
       (setq dadtop (rtos (nth 2(nth n liste)) 2 0))
       (setq demcap (nth 3(nth n liste)))
       (setq demboy (nth 4(nth n liste)))
       (cond ((= tip "DEMIR")
              (setq ibuk (nth 5(nth n liste)))
              (setq sbuk (nth 6(nth n liste)))
             )
             ((= tip "ETRIYE")
              (setq 1yk (nth 5(nth n liste)))
              (setq 2yk (nth 6(nth n liste)))
              (setq 1dk (nth 7(nth n liste)))
              (setq 2dk (nth 8(nth n liste)))
              (setq ibuk (nth 9(nth n liste)))
              (setq sbuk (nth 10(nth n liste)))
             )
       );cond
       ;---начальные точки текста
               
       (setq bassek (polar basnok 0 (* basolc 350)))     
       (command "text" "j" "c" basnok yazyuk 0 pozno)	   
     
     (cond ((= tip "DEMIR")
       (cond ((and (= ibuk "0")(= sbuk "0"))(command "insert" "DEM-DUZ" bassek basolc basolc 0 demboy))
             ((and (/= ibuk "0")(/= sbuk "0"))
              (setq demboy (rtos (- (atof demboy)(atof ibuk)(atof sbuk))2 0))
              (command "insert" "DEM-2" bassek basolc basolc 0 demboy ibuk sbuk)
             )
             ((and (= ibuk "0")(/= sbuk "0"))
              (setq demboy (rtos (- (atof demboy)(atof sbuk))2 0))
              (command "insert" "DEM-1" bassek basolc basolc 0 demboy sbuk)
             )
             ((and (/= ibuk "0")(= sbuk "0"))
              (setq demboy (rtos (- (atof demboy)(atof ibuk))2 0))
              (command "insert" "DEM-1" bassek basolc basolc 0 demboy ibuk)
             )
       );cond
       )
      ((= tip "ETRIYE")
       (command "insert" "DEM-E" bassek basolc basolc 0 1yk 2yk 1dk 2dk ibuk sbuk)
      )
     );cond


       (setq basnok (polar basnok (dtr 270) (* basolc 160)))
       (setq n (+ n 1))
   );for while
 ));for if and progn
;   (setq *error* olderr)
   (setvar "osmode" or-os)
   (princ)
);for defun

; --- TT и CC подпрограммы
(defun yazdeg (son obje / eslis eski delis)
     (setq eslis (entget (car obje)))
     (setq eski (assoc 1 (entget (car obje))))
     (setq delis (subst son eski eslis))
     (entmod delis)
     (princ)
)
; --- Вывод суммы выбранных чисел в выбранный текст
(defun c:TT (/ son obje ss n son lll na say te) 
   (setq ss (ssget) n 0 son 0 lll nil)
   (setq na (ssname ss n))
   (while na
       (setq te (cdr (assoc 0 (entget na))))
       (if (= te "TEXT") (progn
        (setq say (cdr(assoc 1(entget na))))
        (setq son (+ son (atof say)))
        (setq lll (cons (atof say) lll))
       ));if and progn
        (setq n (+ 1 n))
        (setq na (ssname ss n))
   ) ;while
   (princ (strcat "\nСумма: " (rtos son 2 3))) (princ)
   (princ)
   (setq obje (entsel "\nВыберите текст для вывода суммы :"))
   (setq te (cdr (assoc 0 (entget (car obje)))))
   (setq son (cons 1 (rtos son 2 2)))
   (if (= te "TEXT") (yazdeg son obje) (print "\nTEXT degil"))
   (princ)
) ;defun
; --- Произведение выбранных чисел в выбранный текст
(defun c:CC (/ son obje ss n son lll na say te) 
   (setq ss (ssget) n 0 son 1 lll nil)
   (setq na (ssname ss n))
   (while na
       (setq te (cdr (assoc 0 (entget na))))
      (if (= te "TEXT") (progn
       (setq say (cdr(assoc 1(entget na))))
       (setq son (* son (atof say)))
       (setq lll (cons (atof say) lll))
      ));if and progn
       (setq n (+ 1 n))
       (setq na (ssname ss n))
   ) ;while
   (princ (strcat "\nПроизведение : " (rtos son 2 3))) (princ)
   (princ)
   (setq obje (entsel "\nВыберите текст для вывода произведения :"))
   (setq te (cdr (assoc 0 (entget (car obje)))))
   (setq son (cons 1 (rtos son 2 2)))
   (if (= te "TEXT") (yazdeg son obje) (print "\nTEXT degil"))
   (princ)
) ;defun
Kllrnn вне форума  
 
Непрочитано 20.08.2015, 11:56
#5
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от Kllrnn Посмотреть сообщение
что просто может есть что то общеизвестное изза чего старые лиспы не работают в новых версиях автокада
Изменяются порядки запросов в командах, добавляются новые DXF группы к примитивам. В самом коде может быть где-то прописана проверка версии... Здесь код писал явно инженер, так что, скорее всего, где-то в командных методах проблема. Ищите все command, имена команд прописывайте с подчеркиванием и точкой: "text" -> "_.text", опции команд - с подчеркиванием: "j" -> "_j". Если не поможет - то нужно проверять порядки запросов при вызове команд и прочее... В общем случае, можно довольно долго провозиться, а ковырять такой код неинтересно.
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Начиная с 14й версии автокада некорректно работает лисп

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

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Расчет геметрических характеристик сечений, черчение елипс инерции - не работает лисп Student LISP 14 17.02.2014 10:27
Некорректно работает оператор frm Mozgunov Программирование 15 21.12.2008 10:38
лисп вне автокада Димас Разное 12 15.08.2008 15:18
Команда ОФФСЕТ работает некорректно Абдула AutoCAD 4 11.03.2006 16:29