lisp incompatibil cu Autocad 2010

[DorinMuresan]

Salutare!ma poate ajuta si pe mine cineva astfel incat sa-mi modifice urmatorul lisp sa ruleze si pe autocad 2010?Nu vreau sa cer prea mult dar chiar nu am deloc cunostinte in programare si sper sa nu considerati ca ma repet sau ca mi-a fost lene sa dau un search pe forum,am vazut k a mai postat cineva aceiasi problema ca si a mea dar nu am vazut sa-i fie data o solutie. E lispul de generare a tabelului de coordonate pentru o polilinie: TABPOL.


(defun C:tabpol(/ ss e1 e l1 l2 vlist i l2)
;sx a blokkok halmaza amik a polilyne-on vannak
  (setq ss (car (entsel "\nPolylinia:")))
  (setq ss2 (ssget "x" (list (cons 0 "INSERT"))))
  (setq ename ss)
  (setq e1 ss)
  (setq e (entget e1))
  (setq lay (cdr (assoc 8 e)))
  (setq pon (cdr (assoc 70 e)))
  (setq l1 nil)
  (setq l2 nil)
  (setq vlist nil)
  (if (or (= (cdr (assoc 0 e)) "LWPOLYLINE") (= (cdr (assoc 0 e)) "POLYLINE"))
   (progn
    (if (= (cdr (assoc 0 e)) "POLYLINE")
      (progn
        (setq e1 (entnext e1))
        (setq e (entget e1))
        (setq l1 nil)
        (while (/= (cdr (assoc 0 e)) "SEQEND")
          (setq l1 (append (list (cdr (assoc 10 e))) l1))
;          (print (cdr (assoc 10 e)))
          (setq z (cdr (assoc 10 e)))
          (setq e1 (entnext e1))
          (setq e (entget e1))
        )
        (setq l2 (reverse l1))
        (setq i (1- (length l1)))
      ) ;end progn
      (progn
        (setq vlist (entget e1))
        (setq i 0)
        (while (< i (cdr (assoc 90 vlist)))
          (setq l1 (append (list (getLwVert i)) l1))
;          (print (getLwVert i))
          (setq i (1+ i))
        )
        (setq l2 (reverse l1))
        (setq i (1- (length l1)))
      ) ;end progn
    ) ;end if
    (setq ptx (getpoint "\nPunct de inceput tabel:"))
;    (command "text" "J" "R" ptx "" "" "Puncte")
    (command "text" ptx "" "" "==============================")
    (command "text" "" "| Numar|Coordonata|Coordonata|")
    (command "text" "" "| punct|     X    |     Y    |")
    (command "text" "" "|------+----------+----------|")
    (setq i 0)
    (setq sx (ssadd))
    (while (< i (length l1))
      (setq pt (nth i l1))
;(print i)
;a j valtozo vegigpasztazza a Blockkokat hogy melyik block van
;beszurva a csomopontra
      (setq j 0)
      (while (< j (sslength ss2))
        (if (equal (cdr (assoc 10 (entget (ssname ss2 j)))) pt 0.1)
          (progn
            (setq ee1 (entnext (ssname ss2 j)))
            (setq nrs (cdr (assoc 1 (entget ee1))))
            (setq nrs (strx nrs 6))

            (setq pt (cdr (assoc 10 (entget (ssname ss2 j)))))
            (setq x (car pt))
            (setq xs (rtos x 2 2))
            (setq xs (strx xs 10))

            (setq y (cadr pt))
            (setq ys (rtos y 2 2))
            (setq ys (strx ys 10))

            (command "text" "" (strcat "|" nrs "|" ys "|" xs "|"))
            (setq sx (ssadd (ssname ss2 j) sx))
          )
        )
        (setq j (1+ j))
      ) ;end while j
      (setq i (1+ i))
    ) ;end while i
    (command "text" "" "|------+----------+----------|")
    (command "area" "e" ename)
    (setq a (getvar "area"))
    (setq a1 (rtos a 2 2))
    (setq a2 (strcat "S = " a1 " mp"))
    (setq a2 (strx a2 18))
    (command "text" "" (strcat "|     " a2 "     |"))
    (command "text" "" "==============================")

;    (setq sx (ssadd ename sx))
     
;    (command "erase" ename "")
   ) ;end progn
   
   (print "Nu este polilinie")
  ) ;end if
)


(defun getLwVert (tmpctr / count tmp)
    (setq count 0)
    (while (/= (car (nth count vlist)) 10)
        (setq count (+ count 1))
    )
    ;; If the counter reaches the number of vertices,
    ;; reset ctr and tmpctr to zero again.
    (if (= tmpctr (cdr (assoc 90 vlist)))
        (progn
        (setq ctr 0)
        (setq tmpctr 0)
        )
    )
    (setq tmp (nth (+ count (* tmpctr 4)) vlist))
    (setq tmp (append tmp (list (cdr (assoc 38 vlist)))))
    (setq pt1 (trans (cdr tmp) (cdr (assoc -1 vlist)) 1))
;    (setq tmp (cons 10 pt1))
    (setq tmp pt1)
;    (setq tmp tmp)
)

(defun plmodi(lay pon)
       (setq e1 (entlast))
       (setq e_listx (entget e1))
       (setq e_listx
          (subst (cons 8 lay) (assoc 8 e_listx) e_listx)
       )
       (entmod e_listx)
       (entupd e1)
       (setq e_listx (entget e1))
       (setq e_listx
          (subst (cons 70 pon) (assoc 70 e_listx) e_listx)
       )
       (entmod e_listx)
       (entupd e1)
)

(defun strx( nrs nk)
  (setq k1 (strlen nrs))
  (setq k1 (- nk k1))
  (setq k 0)
  (setq sk "")
  (while (< k k1)
    (setq sk (strcat " " sk))
    (setq k (1+ k))
  )
  (setq nrs (strcat sk nrs))
  (princ nrs)
)

lispul il incarca imi cere sa selectez polylinia,dar cand dau click pe ea imi da urmatoarea eroare:Polylinia:; error: bad list: 0

Sper sa ma ajutati chiar daca de la prima postare va cer deja favoruri:), raman dator si sper ca pe viitor sa pot contribui si eu cu interventii utile chiar daca nu sunt legate de programare:D.

[advex]

Incearca sa utilizezi aplicatia tabcord.lsp postata mai jos. Ea face parte din colectia AsmiTools disponibila la http://www.cadtutor.net/forum/showthread.php?43876-AsmiTools

Cod [Selectează] Extinde

;; ==================================================================== ;;
;;                                                                      ;;
;;  TABCORD.LSP - Fills the table in co-ordinates of LwPolyline         ;;
;;                vertexes, and also the centres and radiuses           ;;
;;                of arc segments. Marks vertexes of LwPolyline         ;;
;;                accordingly data in the table by digits or            ;;
;;                letters. Look section 'ADJUSTMENT' for                ;;
;;                acquaintance with options.                            ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  Command(s) to call: TABCORD                                         ;;
;;                                                                      ;;
;;  Select LwPolyline and after the table will be generated             ;;
;;  insert it into the necessary place. After that vertexes of          ;;
;;  polylines will be marked by figures or letters.                     ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY    ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR        ;;
;;  PARTS OF IT ABSOLUTELY FREE.                                        ;;
;;                                                                      ;;
;;  THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY      ;;
;;  DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS        ;;
;;  FOR A PARTICULAR USE.                                               ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.3, 14th Aug 2008, Riga, Latvia                                   ;;
;;  © Aleksandr Smirnov (ASMI)                                          ;;
;;  For AutoCAD 2005 - 2008 (isn't tested in a next versions)           ;;
;;                                                                      ;;
;;                                   http://www.asmitools.com           ;;
;;                                                                      ;;
;; ==================================================================== ;;


(defun c:tabcord(/ aCen cAng cCen cPl cRad cReg
fDr it lCnt lLst mSp pCen pT1
pT2 ptLst R tHt tLst vlaPl vlaTab
vLst cTxt oldCol nPl clFlg actDoc
tPt1 tPt2 cAng tiPt oSnp *error*
mType mHt oZin cAcu dHead hStr
hHt w1 w2 w3 isPer isAre pMul aMul
lWrt aVal xVal yVal)
 

;;;  ****************************************************************
;;;  *************************** ADJUSTMENT *************************
;;;  ****************************************************************

  (setq mType nil) ; Markups mode. T - digits, NIL - letters
 
  (setq tHt -1.0)    ; Table text size. Positive - absolute,
                        ; negative multiplayer to TEXTSIZE variable
 
  (setq mHt -2.0) ; Markups text size. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable
 
  (setq cAcu 4)    ; Precision of coordinates (from 0 to 8)

  (setq dHead nil)    ; If T delete table header, if NIL not delete

  (setq hStr "Land # ") ; Standard header (if dHead not equal T)

  (setq hHt -1.25)      ; Header text size. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable
 
  (setq w1 -10.0)       ; 'Point' column width. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable

  (setq w2 -20.0)       ; 'X' and 'Y' colums width. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable

  (setq w3 -12.0)       ; 'Radius' column width. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable
 
  (setq isPer T) ; if T adds perimeter row

  (setq isAre T)        ; if T adds area row

  (setq isGCen T)       ; if T adds center of gravity row

  (setq pMul 0.001)     ; perimeter multiplayer

  (setq aMul 0.000001)  ; area  multiplayer

;;;  ****************************************************************
;;;  ************************* END ADJUSTMENT ***********************
;;;  ****************************************************************
 
  (if(minusp tHt)
    (setq tHt(getvar "TEXTSIZE"))
    ); end if

  (if(minusp mHt)
    (setq mHt(*(abs mHt)(getvar "TEXTSIZE")))
    ); end if

    (if(minusp hHt)
    (setq hHt(*(abs hHt)(getvar "TEXTSIZE")))
    ); end if

  (if(minusp w1)
    (setq w1(*(abs w1)(getvar "TEXTSIZE")))
    ); end if

  (if(minusp w2)
    (setq w2(*(abs w2)(getvar "TEXTSIZE")))
    ); end if

  (if(minusp w3)
    (setq w3(*(abs w3)(getvar "TEXTSIZE")))
    ); end if

  (vl-load-com)

  (defun Get_Acad_Ver(Gen_Only)
    (if Gen_Only
     (substr(getvar "ACADVER") 1 2)
     (substr(getvar "ACADVER") 1 4)
    ); end if
  ); and of Get_Acad_Ver
 
  (defun Extract_DXF_Values(Ent Code)
    (mapcar 'cdr
     (vl-remove-if-not
      '(lambda(a)(=(car a)Code))
(entget Ent)))
    ); end of


  (defun *error*(msg)
    (setvar "CMDECHO" 1)
    (if oSnp(setvar "OSMODE" oSnp))
    (if oZin(setvar "DIMZIN" oZin))
    (if mSp(vla-EndUndoMark actDoc))
    (princ)
    ); end of *error*

  (defun Alph_Num(Counter / lLst cRes)
  (setq lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
       "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
       "U" "V" "W" "X" "Y" "Z"))
  (if(<= 1.0(setq cRes(/ Counter 26.0)))
     (strcat(itoa(fix cRes))
   (nth(- Counter(* 26(fix cRes)))lLst))
     (nth Counter lLst)
    ); end if
  ); end of Alph_Num


(if(<= 16.1(atof(Get_Acad_Ver nil)))
  (progn
  (if
    (and
      (setq cPl(entsel "\nSelect LwPoliline > "))
      (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
      ); end and
(progn
  (princ "\nPlease Wait... \n")
  (setq vlaPl(vlax-ename->vla-object(car cPl))
ptLst(mapcar 'append
       (setq vLst(Extract_DXF_Values(car cPl)10))
       (mapcar 'list(Extract_DXF_Values(car cPl)42)))
r 2 lCnt 0
tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))
actDoc(vla-get-ActiveDocument
       (vlax-get-acad-object))
mSp(vla-get-ModelSpace actDoc)
    ); end setq
    (setvar "CMDECHO" 0)
    (setq oSnp(getvar "OSMODE"))
    (setq oZin(getvar "DIMZIN"))
    (setvar "DIMZIN" 0)
    (vla-StartUndoMark actDoc)
    (foreach vert ptLst
      (setq vert(trans vert 0 1)
    tLst(append tLst
  (list(list r 0(if mType
  (itoa(1+ lCnt))
    (Alph_Num lCnt)))
  (list r 1(rtos(car vert)2 cAcu))
  (list r 2(rtos(cadr vert)2 cAcu))
  (list r 3 ""))))
      (if(and
   (/= 0.0(last vert))
    (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))
    (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))
   ); end and
(setq r(1+ r)
      cRad(abs(/(distance pt1 pt2)
  2(sin(/(* 4(atan(abs(last vert))))2))))
      aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))
      fDr(vlax-curve-getFirstDeriv vlaPl
   (vlax-curve-getParamAtPoint vlaPl aCen))
      pCen(trans
    (polar aCen(-(if(minusp(last vert)) pi(* 2 pi))
      (atan(/(car fDr)(cadr fDr))))cRad)0 1)
      tLst(append tLst(list
    (list r 0 "center")
    (list r 1(rtos(car pCen)2 cAcu))
    (list r 2(rtos(cadr pCen)2 cAcu))
    (list r 3(rtos cRad 2 cAcu))))
      ); end setq
); end if
      (setq r(1+ r) lCnt(1+ lCnt))
      ); end foreach
  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
(+ 1(/(length tLst)4)) 4 (* 3 tHt)w2))
  (foreach i tLst
    (vl-catch-all-apply 'vla-SetText(cons vlaTab i)) 
    (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)
    (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)
    ); end foreach
  (if(or isPer isAre)
    (progn
   (vla-InsertRows vlaTab r(* 0.05 tHt)1)
   (vla-SetCellTextHeight vlaTab r 0(* 0.05 tHt))
   (setq r(1+ r))
      ); end progn
    ); end if
  (if isPer
    (progn
      (if(= :vlax-true(vla-get-Closed vlaPl))
        (setq lWrt "Perimeter")
(setq lWrt "Length")
       ); end if
      (vla-InsertRows vlaTab r tHt 1)
      (vla-SetText vlaTab r 0 lWrt)
      (vla-SetText vlaTab r 1
(rtos(*(vla-get-Length vlaPl)pMul)2 cAcu))
      (vla-SetCellTextHeight vlaTab r 0 tHt)
      (vla-SetCellTextHeight vlaTab r 1 tHt)
      (setq r(1+ r))
      ); end progn
    ); end if
  (if isAre
    (progn
      (if(= :vlax-true(vla-get-Closed vlaPl))
        (setq aVal (rtos(*(vla-get-Area vlaPl)aMul)2 cAcu))
(setq aVal "Not closed contour")
       ); end if
      (vla-InsertRows vlaTab r tHt 1)
      (vla-SetText vlaTab r 0 "Area")
      (vla-SetText vlaTab r 1 aVal)
      (vla-SetCellTextHeight vlaTab r 0 tHt)
      (vla-SetCellTextHeight vlaTab r 1 tHt)
      (setq r(1+ r))
      ); end progn
    ); end if
  (if(= :vlax-true(vla-get-Closed vlaPl))
    (progn
     (setq nPl(vla-Copy vlaPl))
     (command "_.region" (entlast) "")
     (setq cCen(vlax-get(setq cReg
(vlax-ename->vla-object(entlast)))'Centroid))
      (vla-Delete cReg)
      (setq clFlg T)
     ); end progn
    ); end if
  (if isAre
    (progn
      (if cCen
        (setq xVal(rtos(car cCen)2 cAcu)
      yVal (rtos(cadr cCen)2 cAcu))
(setq xVal "-"
      yVal "-")
       ); end if
      (vla-InsertRows vlaTab r tHt 1)
      (vla-SetText vlaTab r 0 "Gravity Center")
      (vla-SetText vlaTab r 1 xVal)
      (vla-SetText vlaTab r 2 yVal)
      (vla-SetCellTextHeight vlaTab r 0 tHt)
      (vla-SetCellTextHeight vlaTab r 1 tHt)
      (vla-SetCellTextHeight vlaTab r 2 tHt)
      (setq r(1+ r))
      ); end progn
    ); end if
  (vla-put-VertCellMargin vlaTab (* 0.75 tHt))
  (vla-SetColumnWidth vlaTab 0 w1)
  (vla-SetColumnWidth vlaTab 3 w3)
  (if(vlax-property-available-p vlaTab 'RepeatTopLabels)
    (vla-put-RepeatTopLabels vlaTab :vlax-true)
    ); end if
  (if(vlax-property-available-p vlaTab 'BreakSpacing)
    (vla-put-BreakSpacing vlaTab (* 3 tHt))
    ); end if
   (if dHead
     (vla-DeleteRows  vlaTab 0 1)
     (progn
       (vla-SetText vlaTab 0 0 hStr)
       (vla-SetCellTextHeight vlaTab 0 0 hHt)
      ); end progn
    ); end if
  (vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
  (princ "\n<<< Place Table >>> ")
  (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
  (setq lCnt 0)
  (foreach v vLst
    (if clFlg
      (setq cAng(angle cCen(trans v 0 1))
            iPt(polar v cAng (* 2 mHt)))
      (setq tPt1(vlax-curve-GetPointAtParam vlaPl
  (- lCnt 0.0000001))
    tPt2(vlax-curve-GetPointAtParam vlaPl
  (+ lCnt 0.0000001))
    iPt(polar v(+(* pi 0.5)(if(minusp
(setq cAng(angle tPt1(if tPt2 tPt2
   (polar tPt1(* 0.5 pi)0.0000001)))))
cAng(- cAng)))(* 2 mHt))
    ); end setq
      ); end if
    (setvar "OSMODE" 0)
    (setq cTxt(vla-AddText mSp
      (if mType(itoa(1+ lCnt))(Alph_Num lCnt))
       (vlax-3d-point iPt) mHt)
  tiPt(vla-get-InsertionPoint cTxt)
  lCnt(1+ lCnt)
  ); end setq
    (vla-put-Alignment cTxt 10)
    (vla-put-TextAlignmentPoint cTxt tiPt)
    (setq oldCol(getvar "CECOLOR"))
    (setvar "CECOLOR" "1")
    (command "_.circle"(trans v 0 1) (/ mHt 4))
    (setvar "CECOLOR" oldCol)
    ); end foreach
  (setvar "DIMZIN" oZin)
  (setvar "OSMODE" oSnp)
  (setvar "CMDECHO" 1)
  (vla-EndUndoMark actDoc)
  ); end progn
     (princ "\n<!> It isn't LwPolyline! Quit. <!> ")
    ); end if
   ); end progn
  (princ "\n<!> This program works in AutoCAD 2005+ only! <!> " )
  );end if
    (gc)
  (princ)
 ); end of c:tabcord

(princ "\n[Info] http:\\\\www.AsmiTools.com [Info]")
(princ "\n[Info] Type TABCORD to fill table of LwPolyline coordinates [Info]")


[DorinMuresan]

Am incercat lispul, scoate inventar de coordonate dar totodata imi si renumeroateaza el pctele incepand cu litera A si asa le si afiseaza in tabel, iar la suprafata imi spune ca "not closed contour",dar mie imi e inchisa polilinia. Cu tabpol reuseam sa scot inventaru si mi-l afisa cu nr. de puncte ce-l aveam eu in desen,imi afisa si suprafata . Imi e foarte util la anexa 11. Cine poate sa-mi spuna care e diferenta dintre Polylinie si LWPolylinie?sau sa ma ajute cu o modalitata sa extrag inventaru de coordonate(dar inclusiv Z) la toate punctele dintr-o lucrare fara sa mai fiu nevoit sa trag o polilinie prin fiecare punct (mentionez ca punctele sunt block`uri).

Merci Advex pentru alternativa pe care mi-ai oferit-o, dar totodata daca cineva reuseste sa ma ajute cu lispul tabpol raman indatorat

[John Doe]

Nici pe 2007 nu merge, e o eroare undeva in aplicatie. Numai daca o iau linie cu linie pot vedea unde anume este, dar nu prea vad rostul.
Este undeva la sectiunea "Scripturi" o aplicatie care tot treaba asta o face, si chiar functioneaza.

[diagodose2009]

#delete

Modificat de diagodose2009 (18-10-2011 15:17:50)

[John Doe]

Nu mai stiu unde am postat aplicatia de care ziceam; mai jos aveti o versiune care numeroteaza punctele si pune si tabelul de coordonate langa.  Tabelul e facut sub forma de bloc, daca dupa N încercari nu mai vrea dati un PURGE la desen. Cred ca am undeva si niste versiuni mai noi, care si aranjeaza punctele mai ca lumea. Salvati codul intr-un fisier text cu extensia LSP, il incarcati si merge.

Am pus si comentarii, cine vrea sa modifice ceva cred ca va intelege cam despre ce e vorba.

Cod [Selectează] Extinde

;;;pentru planse de parcelare OCPI - numeroteaza punctele de contur si face tabelul cu inventarul de coordonate

(defun C:TAB ()
(setq osn_old (getvar "osmode"))
(setvar "osmode" 0)
(command "pdmode" 35)
(command "pdsize" 1.5)
(command "ortho" "off")
(command "units" "2" "3" "3" "4" "0.0000" "N")
(graphscr)
(command "-style" "Arial" "Arial.ttf" 0 1 0 "N" "N")

(setq pi2 (/ pi 2))
(setq 5pi2 (/ (* 5 pi) 2))
(setq 2pi (* pi 2))
(setq 3pi2 (/ (* pi 3) 2))
(setq mselt (ssadd))


(setq sel (car(entsel "\nSelectati conturul:")));;;obiect
(setq msel (entget  sel));;;lista
(setq lng (length msel))

;;;ar trebui sa vedem cate vertexuri are, ca se suprapune ultimul cu primul
(setq index1 0)
(setq nmax 0)
(while (< index1 lng)
(setq nent1 (nth index1 msel))
(setq index1 (+ 1 index1))
(setq cod1 (car nent1))
(if (= 10 cod1)(setq nmax (+ 1 nmax)));;;asta e nr. maxim de puncte
);;;while
(setq nmax (- nmax 1))
;;;acuma le luam pe rand si scriem
(setq index 0)
(setq ncor 0)
(while (< index lng)
(setq nent (nth index msel));;;element de lista
(setq index (+ 1 index))
(setq cod (car nent))
(if (AND (= 10 cod)(<= ncor nmax))(progn
(setq ncor (+ 1 ncor))
(setq y (cadr nent))
(setq x (caddr nent))
(command "point" (list y x));;;parantezele se inchid mai incolo

(if (= ncor 1)(progn
(command "text" (list (+ 1 y) (+ 1 x)) 3 0 ncor)
(setq pant (list y x))
));;;PROGN+IF ncor=1
(if (> ncor 1)(progn
(setq alfa (angle pant (list y x)))
(setq dist (distance pant (list y x)))
(setq ofs 3)
(if (<= alfa pi2)(setq alfa1 (- alfa 5pi2)))
(if (> alfa pi2)(setq alfa1 (- alfa pi2)))
(if (< dist 5)(setq alfap 1)(setq alfap 0))
(if (AND (< distant 5)(= alfant 1))(setq alfap 0))
(setq alfa1 (+ alfa1 pi (* alfap pi)));;;daca sensul poliliniei e clockwise, se adauga un PI
;;;(setq alfa1 (+ alfa1 (* alfap pi)));;;asa e pentru inversul ceasului - sensul poliliniei
(setq aabs (abs alfa1))
(if (> aabs 2pi)(setq aabs (- aabs 2pi)))
(if (AND (>= aabs 0)(< aabs pi2))(setq jt "BL"))
(if (AND (>= aabs pi2)(< aabs pi))(setq jt "BR"))
(if (AND (>= aabs pi)(< aabs 3pi2))(setq jt "TR"))
(if (AND (>= aabs 3pi2)(< aabs 2pi))(setq jt "TL"))
(setq dx (* ofs (cos alfa1)))
(setq dy (* ofs (sin alfa1)))
(command "text" "J" jt (list (+ y dx) (+ x dy)) 3 0 ncor)
(setq pant (list y x))
(setq distant dist)
(setq alfant alfap)
));;;PROGN+IF ncor>1
;;;=================pentru liniile cap de tabel===========================luam X, Y pentru tabel de aici
(if (= ncor 1)(progn
(setq xs y)
(setq ys x)
(setq ps (list y x))
(command "text" (list xs (+ ys 5)) 3 0 "Nr            X                 Y")
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (- xs 1) (+ ys 4)) (list (+ xs 55) (+ ys 4)) "");;;linia de sub Nr....X....Y
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (- xs 1) (+ ys 9)) (list (+ xs 55) (+ ys 9)) "");;;linia de deasupra Nr...X...Y
(setq mselt (ssadd (entlast) mselt))
));;;PROGN si IF ncor=1
;;;==================================================================================
(if (< ncor 10)(setq sp "     "))
(if (AND (< ncor 100)(>= ncor 10))(setq sp "   "))
(if (>= ncor 100)(setq sp " "))
(setq lin (strcat (itoa ncor) sp (rtos x 2 3) " " (rtos y 2 3)))
(setq yc (- ys (* (- ncor 1) 4.8)))
(command "text" (list xs yc) 3 0 lin)
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (- xs 1) (- yc 1)) (list (+ xs 55) (- yc 1)) "")
(setq mselt (ssadd (entlast) mselt))
));;PROGN si IF  cod=10
);;;WHILE de la index lista entitati

;;;acuma liniile verticale
(command "line" (list (- xs 1) (+ ys 9)) (list (- xs 1) (- yc 1)) "");;;verticala din stanga
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (+ xs 7.7) (+ ys 9)) (list (+ xs 7.7) (- yc 1)) "");;;verticala dintre numar si X
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (+ xs 30.85) (+ ys 9)) (list (+ xs 30.85) (- yc 1)) "");;;verticala dintre X si Y
(setq mselt (ssadd (entlast) mselt))
(command "line" (list (+ xs 55) (+ ys 9)) (list (+ xs 55) (- yc 1)) "");;;ultima
(setq mselt (ssadd (entlast) mselt))

;;;acuma sa vedem ce suprafata are
(command "area" "ob" sel)
(setq supraf (getvar "area"))
(setq sint (fix supraf))
(setq dif (- supraf sint))
(if (>= dif 0.5)(setq supraf (+ 1 sint)))
(setq supraf (rtos supraf 2 0))
(command "text" (list (+ xs 12) (- yc 5)) 3 0 (strcat "S=" supraf " mp"))
(setq mselt (ssadd (entlast) mselt))


;;;-------------acum sa facem conturul gros de 0.8 ca se vede mai bine
(command "pedit" sel "W" 0.8 "")

;;;======aici avem mai multe optiuni; se poate face bloc (mai usor de manipulat pe urma): =============
(if (= nil bn)(setq bn 1)(setq bn (+ 1 bn)))
(setq bname (strcat "b" (itoa bn)));;;facem numele blocului, ca sa nu se suprapuna cu altele
(command "-block" bname ps mselt "");;;il ascunde cu totul si trebe inserat dupa aia
(command "insert" bname pause 1 1 0)
(command "scale" "l" "" ps 1.2);;;scara 1:2000 nu se prea vede, scalam

;;;-------------------se poate lua in memorie, si paste dupa aia
;;(command "_cutclip" mselt "")
;;(command "_pasteclip")

;;;------------------sau se face tabelul normal, si pe urma se muta direct ca il face langa punctul nr. 1
;;;(command "move" mselt "" ps)
;;;==================================================================================
(setvar "osmode" osn_old);;;revenim la osnapul dinainte

);;;DEFUN

(princ "\nLansare cu comanda TAB")



[DorinMuresan]

John Doe merci pt ajutor, am urmarit postarile tale si chiar esti foarte bun. Cred ca toti am avea multe de invatat de la tine. Referitor la lispul ce l-ai postat as avea nevoie de un pic de ajutor(am reusit sa fac sa nu-mi mai ingroase polilinia dar cam aici s-a oprit tot ceea ce am reusit eu sa modific), sper sa nu fiu luat in ras dar pana sa nu dau de forumul acesta chiar nu stiam mai nimic despre lispuri si cu ce se mananca, stiam doar ca ala face aia in autocad si celalalt face altceva daca sunt incarcate, nimic mai mult. Poti sa-mi spui unde trebuie sa sterg in lisp astfel incat sa nu-mi mai puna puncte si nici sa nu mi le mai numeroteze pe cele existene?si se poate modifica sa-mi extraga numarul de punct ce il am eu in plan pentru tabelul de coordonate ce il genereaza?

[advex]

Nu strica sa faci ceva teste cu aplicatia CadTools disponibila la http://www.glamsen.se/CadTools.htm - s-ar putea sa corespunda pentru unele din cerintele tale....

[John Doe]

Se poate.
Undeva scrie:

Cod [Selectează] Extinde

(if (= ncor 1)(progn
            (command "text" (list (+ 1 y) (+ 1 x)) 3 0 ncor)
            (setq pant (list y x))

Pui semnul de comentariu ; in fata randului unde e comanda TEXT:

Cod [Selectează] Extinde

(if (= ncor 1)(progn
            ;(command "text" (list (+ 1 y) (+ 1 x)) 3 0 ncor)
            (setq pant (list y x))
, si nu-ti mai scrie textul cu numarul punctului. La fel, pui punct si virgula in fata randului unde gasesti comanda POINT putin mai sus si nu-ti mai une nici punctele.

Ca sa-ti faca si un fisier cu punctele, in format CSV zic eu, trebuie adaugate vreo trei randuri, dar mai bine le adaug eu si postez inca o data; revin ceva mai incolo.

Si... nu cred ca sunt eu chiar asa de bun, probabil stiu atât cât sa-mi dau seama ce putine stiu de fapt. Iar de învatat avem cu totii unii de la altii, chiar daca uneori nu ne dam seama.

[zamfy]

Dorin, ca sa te putem ajuta, posteaza un fisier dwg cu punctele ca sa vedem in ce format sunt. Din ce am vazut eu, aplicatia tabpol cauta punctele care sunt in desen sub forma de blocuri, apoi te pune sa selectezi o polilinie, iar daca blocurile respective trec prin polilinie, iti genereaza inventarul de coordonate al blocurilor, nu al vertecsilor poliliniei (asta asa, la o prima vedere).
John, aplicatia nu are greseli, numai ca daca ai doar polilinii in desen, fara blocuri, iti da eroare.
Entitatile de tip Polyline s-au folosit pana la AutoCAD R14, dar s-a renuntat la ele, deoarece generau desene uriase pentru acea vreme. La o entitate de tip Polyline, vertecsii sunt entitati distincte,segmentele sunt entitati distincte asa ca la o polilinie formata din 2 vertecsi, aveai de fapt 4 entitati in desen (vertecsii+segmentele).
Asa ca s-au introdus entitatile de tip LWPolyline, unde si vertecsii si segmentele s-au comprimat intr-o singura entitate (o LwPolyline formata din 2 vertecsi=o singura entitate in desen). Astfel, s-au redus si desenele si s-a marit performanta si stabilitatea.
Oricum, toate AutoCAD-urile de la R14 incoace genereaza entitati de tip LWPolyline (adica Light Weight Polyline).
Daca scrii la linia de comanda plinetype 0, o sa iti deseneze polilinii de tip vechi. Daca dai list pe una din ele, o sa vezi ca ai si Polyline si Vertex. Ca sa schimbi la loc, scrii plinetype 2 si o sa iti faca polilinii normale.
La aplicatia tabcord facuta de Smirnov, iti zice "not closed contour", nu pentru ca nu ai inchis tu polilinia, ci pentru ca, chiar daca ai inchis-o, ea este de tip "open", nu "closed" (adica are codul dxf 70 setat la 0, nu la 1). Ca sa o "inchizi", dai comanda pedit, selectezi polilinia, scrii c (de la close) si apoi dai un escape si daca dai list, vei vedea ca e de tip closed.
Bafta!

[advex]

Pentru cei interesati sa obtina inventar care sa contina si coordonata z postez mai jos aplicatia lui Smirnov - 3cord.lsp:

Cod [Selectează] Extinde

;; ==================================================================== ;;
;;                                                                      ;;
;;  3CORD.LSP - Fills the table in co-ordinates of 3DPolyline           ;;
;;              vertexes. Marks vertexes of 3DPolyline                  ;;
;;              accordingly data in the table by digits or              ;;
;;              letters. Look section 'ADJUSTMENT' for                  ;;
;;              acquaintance with options.                              ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  Command(s) to call: 3CORD                                           ;;
;;                                                                      ;;
;;  Select 3DPolyline and after the table will be generated             ;;
;;  insert it into the necessary place. After that vertexes of          ;;
;;  polylines will be marked by figures or letters.                     ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY    ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR        ;;
;;  PARTS OF IT ABSOLUTELY FREE.                                        ;;
;;                                                                      ;;
;;  THIS PROGRAM PROVIDES 'AS IS' WITH ALL FAULTS AND SPECIFICALLY      ;;
;;  DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR FITNESS        ;;
;;  FOR A PARTICULAR USE.                                               ;;
;;                                                                      ;;
;; ==================================================================== ;;
;;                                                                      ;;
;;  V1.3, 14th Aug 2008, Riga, Latvia                                   ;;
;;  © Aleksandr Smirnov (ASMI)                                          ;;
;;  For AutoCAD 2005 - 2008 (isn't tested in a next versions)           ;;
;;                                                                      ;;
;;                                   http://www.asmitools.com           ;;
;;                                                                      ;;
;; ==================================================================== ;;


(defun c:3cord(/ aCen cAng cCen cPl cRad cReg
fDr it lCnt lLst mSp pCen pT1
pT2 ptLst R tHt tLst vlaPl vlaTab
vLst cTxt oldCol nPl clFlg actDoc
tPt1 tPt2 cAng tiPt oSnp *error*
mType mHt oZin cAcu dHead hStr
hHt w1 w2)
 

;;;  ****************************************************************
;;;  *************************** ADJUSTMENT *************************
;;;  ****************************************************************

  (setq mType T) ; Markups mode. T - digits, NIL - letters
 
  (setq tHt -1.0)    ; Table text size. Positive - absolute,
                        ; negative multiplayer to TEXTSIZE variable
 
  (setq mHt -1.0) ; Markups text size. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable
 
  (setq cAcu 4)    ; Precision of coordinates (from 0 to 8)

  (setq dHead T)    ; If T delete table header, if NIL not delete

  (setq hStr "Bnd # ")  ; Standard header (if dHead not equal T)

  (setq hHt -1.25)      ; Header text size. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable
 
  (setq w1 -10.0)       ; 'Point' column width. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable

  (setq w2 -15.0)       ; 'X', 'Y' and 'Z' colums width. Positive - absolute,
                        ; negative - multiplayer to TEXTSIZE variable
 

;;;  ****************************************************************
;;;  ************************* END ADJUSTMENT ***********************
;;;  ****************************************************************
 
  (if(minusp tHt)
    (setq tHt(getvar "TEXTSIZE"))
    ); end if

  (if(minusp mHt)
    (setq mHt(*(abs mHt)(getvar "TEXTSIZE")))
    ); end if

    (if(minusp hHt)
    (setq hHt(*(abs hHt)(getvar "TEXTSIZE")))
    ); end if

  (if(minusp w1)
    (setq w1(*(abs w1)(getvar "TEXTSIZE")))
    ); end if

  (if(minusp w2)
    (setq w2(*(abs w2)(getvar "TEXTSIZE")))
    ); end if

  (vl-load-com)

  (defun Get_Acad_Ver(Gen_Only)
    (if Gen_Only
     (substr(getvar "ACADVER") 1 2)
     (substr(getvar "ACADVER") 1 4)
    ); end if
  ); and of Get_Acad_Ver
 

(defun Extract_3DPoly_Vertexes(Ent / cLst oLst)
    (if(= 'ENAME(type Ent))
      (setq Ent(vlax-ename->vla-object Ent))
      ); end if
    (if(= "AcDb3dPolyline"(vla-get-ObjectName Ent))
      (progn
        (setq cLst(vlax-safearray->list
    (vlax-variant-value
      (vla-get-Coordinates Ent))))
(while cLst
  (setq oLst(cons(list
   (car cLst)
   (cadr cLst)
   (nth 2 cLst))
      oLst)
); end setq
  (repeat 3(setq cLst(cdr cLst)))
   ); end while
(reverse oLst)
); end progn
      ); end if
    ); end of Extract_3DPoly_Vertexes

  (defun *error*(msg)
    (setvar "CMDECHO" 1)
    (if oSnp(setvar "OSMODE" oSnp))
    (if oZin(setvar "DIMZIN" oZin))
    (if mSp(vla-EndUndoMark actDoc))
    (princ)
    ); end of *error*

  (defun Alph_Num(Counter / lLst cRes)
  (setq lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
       "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
       "U" "V" "W" "X" "Y" "Z"))
  (if(<= 1.0(setq cRes(/ Counter 26.0)))
     (strcat(itoa(fix cRes))
   (nth(- Counter(* 26(fix cRes)))lLst))
     (nth Counter lLst)
    ); end if
  ); end of Alph_Num


(if(<= 16.1(atof(Get_Acad_Ver nil)))
  (progn
  (if
    (and
      (setq cPl(entsel "\nSelect 3DPoliline > "))
      (setq vlaPl(vlax-ename->vla-object(car cPl)))
      (= "AcDb3dPolyline"(vla-get-ObjectName vlaPl))
      ); end and
(progn
  (princ "\nPlease Wait... \n")
  (setq ptLst(Extract_3DPoly_Vertexes vlaPl)
r 2 lCnt 0
tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Z"))
actDoc(vla-get-ActiveDocument
       (vlax-get-acad-object))
mSp(vla-get-ModelSpace actDoc)
    ); end setq
    (setvar "CMDECHO" 0)
    (setq oSnp(getvar "OSMODE"))
    (setq oZin(getvar "DIMZIN"))
    (setvar "DIMZIN" 0)
    (vla-StartUndoMark actDoc)
    (foreach vert ptLst
      (setq vert(trans vert 0 1)
    tLst(append tLst
  (list
    (list r 0(if mType
  (itoa(1+ lCnt))
    (Alph_Num lCnt)))
  (list r 1(rtos(car vert)2 cAcu))
  (list r 2(rtos(cadr vert)2 cAcu))
  (list r 3(rtos(nth 2 vert)2 cAcu))))
    ); end setq
      (setq r(1+ r) lCnt(1+ lCnt))
      ); end foreach
  (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
(+ 1(/(length tLst)4)) 4 (* 3 tHt)w2))
  (foreach i tLst
    (vl-catch-all-apply 'vla-SetText(cons vlaTab i)) 
    (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)
    (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)
    ); end foreach
  (vla-put-VertCellMargin vlaTab (* 0.75 tHt))
  (vla-SetColumnWidth vlaTab 0 w1)
  (if(vlax-property-available-p vlaTab 'RepeatTopLabels)
    (vla-put-RepeatTopLabels vlaTab :vlax-true)
    ); end if
  (if(vlax-property-available-p vlaTab 'BreakSpacing)
    (vla-put-BreakSpacing vlaTab (* 3 tHt))
    ); end if
   (if dHead
     (vla-DeleteRows  vlaTab 0 1)
     (progn
       (vla-SetText vlaTab 0 0 hStr)
       (vla-SetCellTextHeight vlaTab 0 0 hHt)
      ); end progn
    ); end if
  (vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
  (princ "\n<<< Place Table >>> ")
  (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")
  (command "_.erase" (entlast) "")
  (command "_.pasteclip" pause)
  (setq lCnt 0)
  (foreach v ptLst
      (setq tPt1(vlax-curve-GetPointAtParam vlaPl
  (+ lCnt 0.0000001))
    tPt2(vlax-curve-GetPointAtParam vlaPl
  (- lCnt 0.0000001))
    iPt(polar v(+(* pi 0.5)(if(minusp
(setq cAng(angle(if tPt1 tPt1 tPt2)
(if tPt2 tPt2(polar tPt1(* 0.5 pi)0.0000001)))))
cAng(- cAng)))(* 2 mHt))
    ); end setq
    (setvar "OSMODE" 0)
    (setq cTxt(vla-AddText mSp
      (if mType(itoa(1+ lCnt))(Alph_Num lCnt))
       (vlax-3d-point iPt) mHt)
  tiPt(vla-get-InsertionPoint cTxt)
  lCnt(1+ lCnt)
  ); end setq
    (vla-put-Alignment cTxt 10)
    (vla-put-TextAlignmentPoint cTxt tiPt)
    (setq oldCol(getvar "CECOLOR"))
    (setvar "CECOLOR" "1")
    (command "_.circle"(trans v 0 1) (/ mHt 4))
    (setvar "CECOLOR" oldCol)
    ); end foreach
  (setvar "DIMZIN" oZin)
  (setvar "OSMODE" oSnp)
  (setvar "CMDECHO" 1)
  (vla-EndUndoMark actDoc)
  ); end progn
     (princ "\n<!> It isn't 3DPolyline! Quit. <!> ")
    ); end if
   ); end progn
  (princ "\n<!> This program works in AutoCAD 2005+ only! <!> " )
  );end if
    (gc)
  (princ)
 ); end of c:3cord

(princ "\n[Info] http:\\\\www.AsmiTools.com [Info]")
(princ "\n[Info] Type 3CORD to fill table of 3D-Polyline coordinates. [Info]")



[John Doe]

@zamfy: asa este, eu am vazut doar asa din zbor ca e vorba si despre SEQUEND si mi-am zis ca pe alea le scrie, nu m-am gandit ca trebuie si blocuri fix in ele.

[DorinMuresan]

JohnDoe merci,am reusit sa-l modific. Acuma e mult mai bine pt mine. De exemplu daca ai gasi in lispul acela ce l-am postat eu (tabpol) exact randurile din el care fac sa-si extraga nr. de punct din plan si le-ai copia in lispul tau nu ar fi mai usor sa-l modifici astfel incat sa faca si el asta?

Zamfy sa stii ca de la cine am primit eu lispul acesta mi-a spus ca a fost creat chiar pentru autocadR14 si ca e foarte vechi,eu l-am folosit doar pe Autocad2006 si acolo imi mergea. Am reusit sa-mi inchid si eu polylinia si mi-a  dat suprafata pana la urma cu lispul tabcord, dar observ ca suprafata e calculata in km2. Cum pot sa-mi setez polylinia in asa fel incat sa mi-o faca tot timpu closed? Si am atasat si un plan (http://fbx.ro/gzqwhbpxm2m10c21) cu tipul de puncte cu care lucrez eu(nr de punct si Z e pe 2 layere diferite),mentionez faptul ca pe acelasi tip de puncte lispul tabpol functioneaza in Autocad2006.

Advex activez lispul 3cord si imi spune ca polilinia nu e 3D, am reusit sa o fac 3D cu aplicatia cadtools de care mi-ai spus mai sus (si in care am gasit cateva chestii interesante, printre care sa-mi exporte coordonatele xyz din blocuri in excel,dar la multe inca nu m-am prins cum functioneaza) doar ca nu-mi scoate Z,la Z imi apare peste tot 0. Sa fie oare din cauza faptului ca punctele mele sunt blocuri?

Pentru cei care mai lucreaza cu puncte de tip block am reusit sa fac rost de un template care scoate Inventaru XYZ:
0              C006000
000            C006000
BL:NAME        C007000
BL:Y            N012003
BL:X            N012003
0,0            N012003
Z              N012003

se copiaza intr-un fisier .txt dupa care se incarca in autocad cu comanda attext

[John Doe]

@DorinMuresan: Pentru tine probabil ar fi misto dar... cum sa zic? ti-am dat un deget doar, nu lua toata mâna. Am si eu ale mele de rezolvat, te rog sa ma intelegi.

Exista si comanda EATTEXT (AutoCAD 2007, in Tools), se foloseste la extragerea atributelor blocurilor, poate fi utila uneori.

[advex]

Advex activez lispul 3cord si imi spune ca polilinia nu e 3D, am reusit sa o fac 3D cu aplicatia cadtools de care mi-ai spus mai sus (si in care am gasit cateva chestii interesante, printre care sa-mi exporte coordonatele xyz din blocuri in excel,dar la multe inca nu m-am prins cum functioneaza) doar ca nu-mi scoate Z,la Z imi apare peste tot 0. Sa fie oare din cauza faptului ca punctele mele sunt blocuri?

Toate blocurile tale au cota 0.00, informatiile despre valoarea z sunt pastrate in atributele blocului. Este necesara mutarea la cota z din atributul 0,0 al blocului 1 (ciudate denumiri ai mai ales!!!).
Dupa ce ai blocurile plasate la z corect, vei obtine si o polilinie 3D.

Incearca aplicatia de mai jos pentru pozitionare blocuri inainte de trasare polilinii:

Cod [Selectează] Extinde

(defun C:schimbz (/ bname elist ent i ip next next_data sset)
  (setvar "cmdecho" 0)
  (command "._undo" "_e")
  (command "._undo" "_g")
  (setq bname (getstring T "\nIntrodu nume block (case-sensitive)\n"))
 
  (prompt "\nSelectie blocuri pentru schimbare z\n")
  (setvar "nomutt" 1)
  (if (setq sset (ssget (list (cons 2 bname))) i -1)
    (progn
    (setvar "nomutt" 0)
    (while (setq ent (ssname sset (setq i (1+ i))))
      (setq elist (entget ent)
    ip (cdr (assoc 10 elist)))
      (setq next ent)
      (setq next    (entnext next)
           next_data (entget next))
      (while (not (eq "SEQEND" (cdr (assoc 0 next_data))))
(if
; (eq "ELEV" (cdr (assoc 2 next_data)))
(eq "0,0" (cdr (assoc 2 next_data)))
  (progn
    (entmod
      (subst
(cons 10 (list (car ip)(cadr ip)(atof (cdr (assoc 1 next_data)))))
(assoc 10 elist) elist))
    (entupd ent)))
    (setq next_data (entget (entnext (cdr (assoc -1 next_data)))))
  )
)
      )
 
    (prompt (strcat "\n\tNu sunt blocuri cu acest nume: "
    "\""      bname
    "\""      " in desen."
   )
    )
  )

  (command "regen")
  (setvar "cmdecho" 1)
  (command "._undo" "_e")
  (princ)
)
(prompt "\nType SCHIMBZ to execute ...")
(princ)