Помогите, пожалуйста, с лиспом...

Помогите, пожалуйста, с лиспом... · 09.11.2005, 18:40

В 14-м акаде был у меня очень удобный лисп. Делал он следующее... При выборе команды вылетало окошко со слайдами блоков, (куда при желании можно было их добавлять), при выборе нужного блока получал возможность вести линию состоящую из этого блока. Вроде все просто, но к сожалению в лиспах я... не силен. :cry:
Удобная штука: тут тебе и фасады подпорных стенок (разной высоты), живая изгородь (в плане/фасаде), гидроизоляция/утеплитель в узлах, ну много всего. Причем получал один примитив, а не несколько блоков. Только блок нужно строить так, чтобы начало блока по У совпадало с его концом (во всех линиях). Очень надеюсь, что понятно объяснил.
Старый лисп у меня есть, но в 2006-м не пашет

Может у кого есть что-то подобное?
Заранее спасибо.
Ой... Не в том разделе написал...

Сорри...
Ребята, перебросьте, плз

Кулик Алексей aka kpblc · 09.11.2005, 18:48

Код - в студию! Или нихьт?

4eh · 09.11.2005, 19:19

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

Код:

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

;                          For Architects
;-----------------INSERTION SLIDES------------------------------------
;
;------VARIABLES :
;      KEY  = "0"                               : Add/Change in Library,
;           =  "Hex Number"  (Library Address)  : Insert in  Library
;      LE   = Component of Special Line (Ent Name)
;      BNAME= Block Name (Special Line)
;      PT1  = Insertion Point
;      PT2  = End Point
;      LEN  = Lenth of Special Line
;      ltype= Line Type
;      LST  = List of Special Lines:    '('(Length Flag)...'(...))
;------------------------------------------------------------------------
(setvar "CMDECHO" 0)
;--Read List of Lines From File
(setq LST (slinlst "r" LST))            ;---'('(Length Flag)...'(...))
;---ADD/CHANGE---
(cond 
((= KEY "0")              
     (setq PT1 (getpoint "\nStart Point:")
           PT2 (getpoint "\nEnd Point:")
           LEN (distance PT1 PT2) 
     )
     (prompt "\nSelect objects: ")
     (setq SSET (ssget)
           LSET (sslength SSET)
           I 0
           TFLAG nil
     );
     (while (< I LSET)
       (setq LE (ssname  SSET I)
             I  (+ 1 I)
             ltype (cdr (assoc 0 (entget LE)))
             TFLAG (cond ((= "ATTDEF" ltype) (if TFLAG (1+ TFLAG) 1))
                         ((and (null TFLAG) (= "TEXT" ltype)) 0)
                         (T TFLAG)
                   );cond      
       );setq 
     );while
 (setq KEY (get_lin_add))
 (prompt "\nKEY=")(prin1 KEY)
 (setq NUM (cond ((= KEY "F") 15)
                 ((= KEY "E") 14)
                 ((= KEY "D") 13)             
                 ((= KEY "C") 12)
                 ((= KEY "B") 11)
                 ((= KEY "A") 10)
                 (T (atoi KEY))      
           );cond
       FRONT '()
 )
 (repeat (1- NUM)
   (setq FRONT (append FRONT (list (car LST)))
         LST (cdr LST)
   )
 )
 (setq NLIN (list (list LEN TFLAG))      ;--Update List of Lines
       LST (append FRONT NLIN (cdr LST))
       FNAME (#SHM (strcat "lib\\_SL" KEY))
 );setq     
   (command "sh" (strcat "del " FNAME ".dwg"))
   (command "MSLIDE" (#SHM (strcat "sld\\_SL" KEY)))
   (command "WBLOCK" FNAME "" PT1 SSET "")
   (slm_slb)                                      ;--Make Slide Library
   (slinlst "w" LST)                    ;---'('(Length Flag)...'(...))
 );cond KEY=0 
;------INSERT---
 (T                    ;---if KEY not 0 - KEY=Library Address    
   (setq SLIN (nth (1- (cond ((= KEY "F") 15)
                             ((= KEY "E") 14)
                             ((= KEY "D") 13)             
                             ((= KEY "C") 12)
                             ((= KEY "B") 11)
                             ((= KEY "A") 10)
                             (T (atoi KEY))              
                       );cond 
                     )
              LST);nth 
       LEN (car SLIN)
       TFLAG (cadr SLIN)
       BNAME (#SHM (strcat "lib\\_SL" KEY))
    );setq
    ;---Drawing Special Lines:
   (if (findfile (strcat bname ".dwg"))   
       (sline BNAME LEN TFLAG)                            ;---True
       (prompt "\nSpecial Line Does Not Exist.")          ;---False
   );if findfile
 );cond T
);cond
(princ)
);defun splib
)
;-----------READ/WRITE LIST OF LINES: --------------------------------------
(defun slinlst (resp LST / FP FNAME TLST)
;--------VARIABLES:
;        FP,FNAME    = Pointer,Name of Sourse File
;        LINE        = Member of List of Special Lines: '(Length Flag)
;        TLST        = Temporary List
;--------------------------------------------
 (setq FNAME (#SHM "lib\\_SL.typ")
       TLST '())
  (cond ((= resp "r")                                   ;---Read
         (if (findfile fname)
           (load FNAME)                                 ;---True  
           (progn                                       ;---False
             (princ "\nSpecial line Definition file not found !!!")
             (princ "\nRecreating base file")
             (repeat 14
               (setq TLST (append TLST (list (list 100 nil))))
             )
           )
         );if
         TLST                                                ;---Result
       );=resp "r"
       ((= resp "w")                                   ;---Write
         (setq FP (open FNAME "w"))
         (princ "(setq TLST '" fp)
         (princ LST FP)                         ;---Write LST
         (princ ")" fp)
         (close FP)
       );=resp "w"
 );cond
 );defun  slinlst   
;-------------------------------------------------
(defun get_lin_add ()
;-------------------------GETTING SLIDE LIBRARY ADDRESS
 (PROMPT "\nChoose library element: ")
 (menucmd "i=slin")(menucmd "i=*")
 (substr (getstring) 9 1)
);defun
;----------------------Make Slide Library-----------------------------
(defun slm_slb ()
   (setq fname (#SHM "sld\\slin.txt")
         fp (open fname "w")
         i 1
   )
   (repeat 16
     (write-line
       (#SHM 
        (cond ((= i 16) "sld\\exit.sld")
              ((= i 15) "sld\\_SLf.sld")
              ((= i 14) "sld\\_SLe.sld")
              ((= i 13) "sld\\_SLd.sld")
              ((= i 12) "sld\\_SLc.sld")
              ((= i 11) "sld\\_SLb.sld")
              ((= i 10) "sld\\_SLa.sld")
              (T  (strcat "sld\\_SL" (itoa i) ".sld"))
        );cond
       );#SHM
     fp
     );write
     (setq i (1+ i))  
   );repeat 
   (close fp)
   (textscr)
   (command "sh" "cls")
   (setq exe (findfile "slidelib.exe"))
   (if exe
     (command "sh" 
       (strcat exe " " 
         (#SHM "_sl")
         " < " fname 
       )
     )
     (progn
       (princ "\nSLIDELIB.EXE not found in AutoCAD search directories !!!")
       (princ "\nCopy the file from AutoCAD diskettes and repeat.")
       (getstring "\n\nPress ENTER to continue . . . ")
     )
   ) 
   (command "del" fname)
   (graphscr)
)
;------------------------------------------------------------------------
; Special line types.
; 2-9-90 Rafael Sacks.
; 13-8-91 Updated
; 17-5-92 Updated By Marina Levine
(defun sline (bname base tflag / lflag ans sp tp a d n s i entl p)
(princ "\nSpecial line: (c) Shacham Ltd. 1990")
  (initget "Line")
  (setq ans (getpoint "\nLine/<From Point>: "))
  (setq tp T)
  (if (/= ans "Line")
      (setq sp ans
            tp (getpoint sp "\nTo point: ")
      )
  )
    (while tp                                                
    (cond ((= ans "Line")
           (setq le (car (entsel "\nSelect line: "))
                 ll  (if le (entget le) nil)
                 sp (if le (cdr (assoc 10 ll)) nil)
                 tp (if le (cdr (assoc 11 ll)) nil)
                 lflag (if le T nil)
           )
           (if le (entdel le))
          )
    )
    (if  (or le (/= ans "Line"))
    (progn
    (setq a (* (/ 180 pi) (angle sp tp))
          d (if (and sp tp) (distance sp tp)nil)
          n (if d (fix (/ d base)) nil)
          p1 sp 
          p2 tp
    )
    (if (and tflag (> a 90) (<= a 270)) (setq p1 tp p2 sp a (+ a 180)))
    (if (> n 0) (setq s (/ d (* n base)) i (* base s)))
    );progn
    )
    (cond ((= n nil) (princ "kuku") 
          )
          ((= n 0) 
           (command "line" p1 p2 "")
           (princ "\nLine too short.")
          )
          ((= n 1)
           (command "minsert" bname p1 s "1" a "1" n)
           (if tflag (repeat tflag 
             (setq att (getstring "\nAttribute value: "))
             (command att)
           ))
           (setq entl (entget (entlast))
                 entl (append entl (list (cons 44 d)))
           )
           (entmod entl)
          )
          (T 
           (command "minsert" bname p1 s "1" a "1" n i)
           (if tflag (repeat tflag 
             (setq att (getstring "\nAttribute value: "))
             (command att)
           ))
          )
    )
    (setq sp tp
          TP (if lflag T 
                 (if (/= ans "Line")
                     (getpoint sp "\nTo point: ") 
                      nil
                 )
              )
    )
  );while tp
  (princ)

  );defun sline
;
; convert sline to line
;
(defun c:usl (/ sle pt an pt2 sll le sc)
  (setq sll (car (entsel "\nSelect special line: "))
        sle (entget sll)  )
  (setq lines 
    (list '("lf" 300) 
          '("x" 110)
    )
  )
  (cond ((= (cdr (assoc 0 sle)) "INSERT")
         (setq bl (cdr (assoc 2 sle))
               pt (cdr (assoc 10 sle))
               an (cdr (assoc 50 sle))
               sc (cdr (assoc 70 sle))
               sc (if (= sc 0) 1 sc)
               le (* (cdr (assoc 44 sle)) sc)
               pt2 (polar pt an le)
         )
         (command "erase" sll "")
         (command "line" pt pt2 "")
        )
        (T
         (princ "\nThis function does not operate on this element.")
        )
  )
  (princ)
)

и несколько блоков могу кинуть. Длина блока не должна быть большой, иначе при длине линии меньше блока ничего не выйдет (у меня раньше в этом случае получался просто отрезок).
Продлема-то у меня какая, вроде должно работать, но слайды не грузятся. Где то есть заусенец.

Кулик Алексей aka kpblc · 10.11.2005, 10:15

Код приведен не полностью - нет объявления splib, и одна лишняя закрывающая скобка.

4eh · 10.11.2005, 11:34

kpblc, мамой клянусь, не специально. У меня несколько вариаций, хотел дать поновее.
Это оригинал. (я уже во всем стал сомневаться, но думаю оригинал). Может тебе нужны DCLки? Только скажи... Для затравки и примера посмотри стеночку. Можно с hatch-ем, можно без. Эта - без, меньше весит. Ее можно гнать метражем. Библиотечка разбита по темам, в каждой ~по 20 слайдов. Действительно удобно. Блоки слегка поджимаются/растягиваются чтобы уложиться кратно (целиком). Может для 2006 все иначе? Попробуй, а...

Код:

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

(defun splib (KEY / LE BNAME PT1 PT2 LEN ltype LST)                   
;-----------------INSERTION SLIDES------------------------------------
;
;------VARIABLES :
;      KEY  = "0"                               : Add/Change in lib,
;           =  "Hex Number"  (Library Address)  : Insert in  Library
;      LE   = Component of Special Line (Ent Name)
;      BNAME= Block Name (Special Line)
;      PT1  = Insertion Point
;      PT2  = End Point
;      LEN  = Lenth of Special Line
;      ltype= Line Type
;      LST  = List of Special Lines:    '('(Length Flag)...'(...))
;------------------------------------------------------------------------
(setvar "CMDECHO" 0)
;---ADD/CHANGE---
(cond 
((= KEY "0")              
     (setq PT1 (getpoint "\nStart Point:")
           PT2 (getpoint "\nEnd Point:")
           LEN (distance PT1 PT2) 
     )
     (prompt "\nSelect objects: ")
     (setq SSET (ssget)
           LSET (sslength SSET)
           I 0
           TFLAG nil
     );
     (while (< I LSET)
       (setq LE (ssname  SSET I)
             I  (+ 1 I)
             ltype (cdr (assoc 0 (entget LE)))
             TFLAG (cond ((= "ATTDEF" ltype) (if TFLAG (1+ TFLAG) 1))
                         ((and (null TFLAG) (= "TEXT" ltype)) 0)
                         (T TFLAG)                   );cond      
       );setq 
     );while
 (setq KEY (get_lin_add)
       SKEY (substr KEY 2 1)
       )
 
 (setq NUM (cond ((= SKEY "F") 15)
                 ((= SKEY "E") 14)
                 ((= SKEY "D") 13)             
                 ((= SKEY "C") 12)
                 ((= SKEY "B") 11)
                 ((= SKEY "A") 10)
                 (T (atoi SKEY))      
           );cond
       FRONT '()
 )
 ;--Read List of Lines From File
(setq LST (slinlst "r" LST (substr key 1 1)))     ;---'('(Length Flag)...'(...))
 (repeat (1- NUM)
   (setq FRONT (append FRONT (list (car LST)))
         LST (cdr LST)
   )
 )
 (setq NLIN (list (list LEN TFLAG))      ;--Update List of Lines
       LST (append FRONT NLIN (cdr LST))
       FNAME (_XSH: (strcat "lib\\_SL" KEY ".dwg"))
       newslide (_XSH: (strcat "sl" KEY ".sld"))
       libname (strcat "sL" (substr key 1 1))
 );setq 
 (command "MSLIDE" newslide) 
 (if (findfile fname)
   (command "WBLOCK" FNAME "Yes" "" PT1 SSET "")
   (command "WBLOCK" FNAME "" PT1 SSET "")
 )   
 (slm_slb  libname newslide)              ;--Make Slide lib
 (command "del" newslide)
 (slinlst "w" LST (substr key 1 1))               ;---'('(Length Flag)...'(...))
 );cond KEY=0 
;------INSERT---
 (T                    ;---if KEY not 0 - KEY=lib Address    
   ;--Read List of Lines From File
   (setq LST (slinlst "r" LST (substr key 1 1)))    ;---'('(Length Flag)...'(...))
   (setq SKEY (substr KEY 2 1)
         SLIN (nth (1- (cond ((= SKEY "F") 15)
                             ((= SKEY "E") 14)
                             ((= SKEY "D") 13)             
                             ((= SKEY "C") 12)
                             ((= SKEY "B") 11)
                             ((= SKEY "A") 10)
                             (T (atoi SKEY))              
                       );cond 
                     )
              LST);nth 
       LEN (car SLIN)
       TFLAG (cadr SLIN)
       BNAME (_XSH: (strcat "lib\\_SL" KEY))
    );setq
    ;---Drawing Special Lines:
   (if (findfile (strcat bname ".dwg"))   
       (sline BNAME LEN TFLAG)                            ;---True
       (prompt "\nSpecial Line Does Not Exist.")          ;---False
   );if findfile
 );cond T
);cond
(princ)
(graphscr)
);defun splib

;-----------READ/WRITE LIST OF LINES: --------------------------------------
(defun slinlst (resp LST no / FP FNAME TLST)
;--------VARIABLES:
;        resp        = Responce "w" , "r"
;        LST         = List Of Special Lines 
;        no          = Number Of lib (1,2,3,4)
;        FP,FNAME    = Pointer,Name of Sourse File
;        LINE        = Member of List of Special Lines: '(Length Flag)
;        TLST        = Temporary List
;--------------------------------------------
 (setq FNAME (_XSH: (strcat "lib\\_SL" no ".typ"))
       TLST '())
  (cond ((= resp "r")                                   ;---Read
         (if (findfile fname)
           (load FNAME)                                 ;---True  
           (progn                                       ;---False
             (princ "\nSpecial line Definition file not found !!!")
             (princ "\nRecreating base file")
             (repeat 14
               (setq TLST (append TLST (list (list 100 nil))))
             )
           )
         );if
         TLST                                                ;---Result
       );=resp "r"
       ((= resp "w")                                   ;---Write
         (setq FP (open FNAME "w"))
         (princ "(setq TLST '" fp)
         (princ LST FP)                         ;---Write LST
         (princ ")" fp)
         (close FP)
       );=resp "w"
 );cond
 );defun  slinlst   
;-------------------------------------------------
(defun get_lin_add (/ K com)
;-------------------------GETTING SLIDE lib ADDRESS
 (PROMPT "\nChoose library element: ")
 (menucmd "i=slin")(menucmd "i=*")
 (setq K (substr (getstring) 9 1)
       com (strcat "i=lib" K)
 )
 (menucmd com)(menucmd "i=*")
 (substr (getstring) 9 2)
);defun
;----------------------Make Slide Library-----------------------------
(defun SLM_SLB (chapter newslide / fname fp key exe)
   (setq exe (_xsh: "sldmgr.exe"))
   (if exe
     (progn
       (command "sh" (strcat exe " d " (_XSH: chapter) " " newslide))
       (command "delay" "1000")
       (command "sh" (strcat exe " a " (_XSH: chapter) " " newslide))
     )
     (progn
       (princ "\nSLDMGR.EXE not found in AutoCAD search directories !!!")
       (princ "\nCopy the file from Shacham diskette and repeat.")
       (getstring "\n\nPress ENTER to continue . . . ")
     )
   )
   (graphscr)
)

;------------------------------------------------------------------------
; Special line types.
;(setq li-va '(sp tp base))
(defun sline (bname base tflag / lflag ans ll le sp tp a d n s i entl p
                                 scnd )
  (princ "\nConnect line: (c) Shacham Ltd. 1993")
  (setq result nil scnd nil)  (initget "Line")
  (setq ans (getpoint "\nLine/<From Point>: "))
  (setq tp T etype nil)
  (if (/= ans "Line")
      (setq sp ans
            tp (getpoint sp "\nTo point: ")
      )
  )
 (while tp                                                
 (cond ((= ans "Line")        (setq le (if (and le (= etype "POLYLINE")) le (entsel "\nSelect Line or Polyline: "))
              le (if le (if (= etype "POLYLINE") le (car le)) nil)
              el (if le (entget le) nil)
              etype (if el (cdr (assoc 0 el)) nil)
         )
        (cond ((= etype "POLYLINE")
               (setq result (if result result (l2pl le))
                     sp (cadr (car result))
                     tp (caddr (car result))
                     lflag nil
               )
              )   
              ((= etype "LINE")
               (setq  ll  (if le (entget le) nil)
                      sp (if le (cdr (assoc 10 ll)) nil)
                      tp (if le (cdr (assoc 11 ll)) nil)
                      lflag (if le T nil)
                )
                (if le (entdel le))                        ;;;tos
               )
          (T (while (and etype (/= etype "POLYLINE")(/= etype "LINE"))
              (if (/= 2 (alert "Entity Selected is not Line Or Polyline"))(exit))
              (setq le (entsel "\nSelect Line or Polyline: ")
                    le (if le (if (= etype "POLYLINE") le (car le)) nil)
                    el (if le (entget le) nil)                    etype (if el (cdr (assoc 0 el)) nil)
              )
              );while
              (if (= etype "POLYLINE")
               (setq result (if result result (l2pl le))
                     sp (cadr (car result))
                     tp (caddr (car result))
                     lflag nil
               )
               ; else (= etype "LINE")
               (setq  ll  (if le (entget le) nil)
                      sp (if le (cdr (assoc 10 ll)) nil)
                      tp (if le (cdr (assoc 11 ll)) nil)
                      lflag (if le T nil)
                )
              );if
          ); cond T
     );cond etype
   );cond (= ans "Line")
 );cond 

    (if (or le (/= ans "Line"))
    (progn
;(dbg 3 1)    
    (setq a (* (/ 180 pi) (angle sp tp))
          d (if (and sp tp) (distance sp tp)nil)
          n (if d (fix (/ d base)) nil)
          p1 sp 
          p2 tp
    )    );progn
    );if
    
    (if (and tflag (> a 90) (<= a 270)) (setq p1 tp p2 sp a (+ a 180)))
    (if (> n 0) (setq s (/ d (* n base)) i (* base s)))
    ;(princ "p1= ")(princ p1)(princ " ")(princ "p2= ")(princ p2)
;(dbg 11 1)    
        (cond ((= n nil) (princ) 
          )
          ((= n 0) 
           (command "line" p1 p2 "")
           (princ "\nLine too short.")
          )
          ((= n 1)
;(dbg 12 1)    
           (command "minsert" bname p1 s "1" a "1" n)
           (if tflag (repeat tflag 
             (setq att (getstring "\nAttribute value: "))
             (command att)
           ))
           (setq entl (entget (entlast))
                 entl (append entl (list (cons 44 d)))
           )
           (entmod entl)
          )
          (T 
;(dbg 13 1)    
           (command "minsert" bname p1 s "1" a "1" n i)
           (if tflag (repeat tflag 
             (setq att (getstring "\nAttribute value: "))
             (command att)
           ))
          )
    )
;(dbg 1 1)    

    (setq sp tp )
    (setq result (if result (cdr result) nil))
    (if result (while (= (car (car result)) "ARC")
                  (setq result (cdr result))
                )
    )
    (setq TP (if lflag T 
                 (if (/= ans "Line")
                     (getpoint sp "\nTo point: ") 
                     (if (/= etype "POLYLINE") nil (cadr (car result)))
                 )
              )
    )
;(dbg 5 1)    
             (if(= ans "Line")
                (if (and le(not scnd))
                  (setq scnd T)
;(dbg 5 1)    
                )
             )
;                   (entdel(entlast))
;                )
;             )   
;             (setq scnd T)
  );while tp
   (if (= etype "POLYLINE")  
     (if le 
      (progn 
;(dbg 7 1)    
       (setq e (entlast))
       (command "explode" le)
       (while (setq e (entnext e))
        (if (= (cdr (assoc 0 (entget e))) "LINE")(entdel e))
       )
      )
     )
     (progn
       (if(and scnd(= ans "Line"))
          (entdel(entlast))
;(dbg 9 1)
       )   
     )
  );if etype
  (redraw)
  (princ)
);defun sline
;
; convert sline to line
;
(defun c:usl (/ sle pt an pt2 sll le sc)
  (setq sll (car (entsel "\nSelect special line: "))
        sle (entget sll)
  )
  (setq lines 
    (list '("lf" 300) 
          '("x" 110)
    )
  )
  (cond ((= (cdr (assoc 0 sle)) "INSERT")
         (setq bl (cdr (assoc 2 sle))
               pt (cdr (assoc 10 sle))
               an (cdr (assoc 50 sle))
               sc (cdr (assoc 70 sle))
               sc (if (= sc 0) 1 sc)
               le (* (cdr (assoc 44 sle)) sc)
               pt2 (polar pt an le)
         )
         (command "erase" sll "")
         (command "line" pt pt2 "")
        )
        (T
         (princ "\nThis function does not operate on this element.")
        )
  )
  (princ)
) 
(defun mklib (KEY SL)                       
;-----------------INSERTION SLIDES------------------------------------
;
;------VARIABLES :
;      #p   = External 1 - Make SLide lib
;                      0 - Get Icon Menu
;      KEY  = "Hex Number" - lib Address
;      SL   = Slide To Exchange
;      com  = Icon Name
;------------------------------------------------------------------------
(setvar "CMDECHO" 0)
;---Show Slides
(cond 
((= #p 0) 
     (setq #com (strcat "i=lib" KEY))
     (menucmd #com)(menucmd "i=*")
);cond  (= #p 0)
;------Change Header Slide
 (T             ; = #p 1
   (setq #p 0 
         newslide (_XSH: (strcat SL ".sld"))
         mainslb "sline"
   )
   (command "MSLIDE" newslide)
   (slm_slb "sline" newslide)              ;--Make Slide lib
   (command "del" newslide)
 );cond T
 );cond
(princ)
);defun mklib

;-------------------------------------------------
(defun exec(cmd) (command "shell" cmd))
;-------------------------------------------------
(defun l2pl (e)
  (setq result '()
        i 0
  ;      l (sslength eset)
  )
  ;(while (< i l)
    (setq                           ;e (ssname eset i)
          el (entget e)
          etype (cdr (assoc 0 el))
    )
    (cond ((= etype "ARC")
           (setq ptc '(0 0)
                 r 10.0
                 a1 1.0
                 a2 1.0
                 result (append result (list (list "ARC" ptc r a1 a2)))
           )
          )
          ((= etype "LINE")
           (setq pt1 (cdr (assoc 10 el))
                 pt2 (cdr (assoc 11 el))
                 result (append result (list (list "LINE" pt1 pt2)))
           )
          )
          ((= etype "POLYLINE")
           (setq result (append result (breakpoly e result)))
          )
    )
    (setq i (1+ i))
  ;)
  result
) 
(defun breakpoly (pline result / ver verl vtype result bulge pt1 )
  (setq closed (= 1 (cdr (assoc 70 (entget pline))))
        ver (entnext pline)
        verl (entget ver)
        pt0 (cdr (assoc 10 verl))
        vtype (cdr (assoc 0 verl))
        result '()
  )
  (while (/= vtype "SEQEND")
    (setq bulge (cdr (assoc 42 verl))
          pt1 (cdr (assoc 10 verl))
          ver (entnext ver)
          verl (entget ver)
          pt2 (cdr (assoc 10 verl))
          vtype (cdr (assoc 0 verl))
    )
;    (princ "\nVertex : ")(princ pt1)(princ " bulge=")(princ bulge)
    (if (/= vtype "SEQEND") (progn
      (if (= bulge 0.0)                   ; LINE
        (setq result (append result (list (list "LINE" pt1 pt2))))
        (setq x (/ (distance pt1 pt2) 2.0)
              r (/ (+ (* x x) (* bulge bulge)) (* bulge 2.0))
              cen '(0 0)
              ang1 (angle cen pt1)
              ang2 (angle cen pt2)
              result (append result (list (list "ARC" cen r ang1 ang2)))
        )
      )
    ));
  )
  (if closed
    (if (= 0.0 bulge)
      (setq result (append result (list (list "LINE" pt1 pt0))))
    )
  )
  result
)

[ATTACH]1131611646.dwg[/ATTACH]

4eh · 13.11.2005, 22:54

kpblc, скажи есть на что надеятся? Или... того... не стоит. :roll:
Оч-чень, понимаешь, хорошая штука. Много бы пользы людям было бы...

Кулик Алексей aka kpblc · 14.11.2005, 08:24

Пытаюсь разобраться с логикой, пока что-то не очень... Если что получится, обязательно скажу.

4eh · 14.11.2005, 08:45

если не получится, тоже скажи... :wink:

Кулик Алексей aka kpblc · 14.11.2005, 09:53

Ну в общем тут дело такое... Чего-то у меня мозги закипели (квалификации все ж маловато). Кое-что нарыл:
В функции splib: а что возвращает функция (_xsh: (strcat <...>))? Возможно, здесь проблема? Т.е. newslide на момент выполнения чему равен?
Здесь:

Код:

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

	   slin	 (nth (1- (cond	((= skey "F") 15)
				((= skey "E") 14)
				((= skey "D") 13)
				((= skey "C") 12)
				((= skey "B") 11)
				((= skey "A") 10)
				(t (atoi skey))
				) ;_ end of cond
			  ) ;_ end of 1-
		      lst
		      ) ;_ end of nth

чего получается? Если key на момент вызова длиной 1 символ (и не "0"), то skey будет "", и (atoi key") вернет 0.
И вот еще - у тебя там не производится обработка LWPOLYLINE, а POLYLINE, по-моему, не поддерживает дуговые сегменты. Так что проблема еще и здесь может быть.
Т.е. замени POLYLINE везде на LWPOLYLINE и попробуй еще разок запустить на выполнение - сработает или нет?

4eh · 15.11.2005, 14:22

Понимаешь, процесс проходит в 2 этапа. В первом появляется библиотека разделов (т.е. например: фасады, планы, узлы... ) Это поднялось и я вижу таблицу с нужными слайдами разделов. Слева в окне список (названия разделов), справа - таблица слайдов (разделы). До сих пор порядок. Теперь при попытке зайти в нужный раздел (двойной клик по слайду) должен открыться второй этап (такая же таблица, но уже с элементами - блоками этого раздела). Вот тут все и застревает. Появляется таблица, но без слайдов (пустая). И, естественно, без списка. (Вот где собака... порылась). Понимаю, что застревает на какой-то ерунде, а найти ее не могу. Абидно, слушай...
Посмотри на картинку, даже в разделах многие слайды исчезли

[ATTACH]1132053749.jpg[/ATTACH]
Полилинии все поменял, но... все тоже самое - не пашет

09.11.2005, 18:40		#1
Помогите, пожалуйста, с лиспом... 4eh Регистрация: 07.09.2005 Сообщений: 97 В 14-м акаде был у меня очень удобный лисп. Делал он следующее... При выборе команды вылетало окошко со слайдами блоков, (куда при желании можно было их добавлять), при выборе нужного блока получал возможность вести линию состоящую из этого блока. Вроде все просто, но к сожалению в лиспах я... не силен. :cry: Удобная штука: тут тебе и фасады подпорных стенок (разной высоты), живая изгородь (в плане/фасаде), гидроизоляция/утеплитель в узлах, ну много всего. Причем получал один примитив, а не несколько блоков. Только блок нужно строить так, чтобы начало блока по У совпадало с его концом (во всех линиях). Очень надеюсь, что понятно объяснил. Старый лисп у меня есть, но в 2006-м не пашет Может у кого есть что-то подобное? Заранее спасибо. Ой... Не в том разделе написал... Сорри... Ребята, перебросьте, плз
Просмотров: 3348