Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

why don´t work this lips in autocad 2015?

3 REPLIES 3
SOLVED
Reply
Message 1 of 4
andresep82
504 Views, 3 Replies

why don´t work this lips in autocad 2015?

hello again,

 

I am trying the new version of autocad,and   this lips don´t work,why?

 

 

(vl-load-com)

(princ "\superficie_campo Cargada. Escribe \"sup\" para empezar..")


(defun c:sup ( / sele cod mens TotArea mens )

  (if (not (tblsearch "LAYER" "SUP_UTIL"))
    (command "_.-layer" "_make" "SUP_UTIL" "_color" 3 "" "")
  )

 (if (not (tblsearch "LAYER" "TEXTO_HABITACIONES"))
    (command "_.-layer" "_make" "TEXTO_HABITACIONES" "_color" 7 "" "")
  )


(setvar "fieldeval" 23)   



(setvar "fielddisplay" 0)


(setvar "cmdecho" 0)
 (setq TotArea 0.0 )

(setvar 'clayer "TEXTO_HABITACIONES");change layer
 
 (prompt "\nSeleccione Polilineas para suma de Areas: ")

 (if 

;(setq sele (ssget (list  '(0 . "LWPOLYLINE") )))

(setq sele (ssget    '( (0 . "LWPOLYLINE") (8 . "SUP_UTIL" ) )))
  (progn
   (vl-cmdf "_.UNDO" "_BE")
   (setq Cod 0 )



(initget 7) 
 
(setq depend (getint "\n Numero inicial"))



 (mapcar (function (lambda (LwPol /  Centroid )

   



 (repeat

 (setq i (sslength sele))
        (setq e (ssname sele cod))
               
      

); end repeat

(setq Cod (1+ Cod))


(setq contorno e )

(setq objeto (vlax-ename->vla-object contorno)


Id (vla-get-objectID objeto)
     
super (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "(itoa Id)">%).Area \\f \"%lu2%pr2%ps%ds44\">%")

);END SETQ

     
    (setq Centroid (CentroidePol LwPol))



(setq inicial (getvar "attdia"))

 

(setvar "attdia" 0)


(setvar "ATTREQ" 1) ; fix possible attribute prompting issue

          
(setq dependencia (itoa depend))


   (command "_insert" "superficie" centroid "" "" "" dependencia super )

(setq depend ( 1+ depend))

(setvar "attdia" inicial)

   ))  

(SsToList sele)


);c.mapcar 
   
   (princ)
      
   
   (vl-cmdf "_UNDO" "_E")
  );c.prg
  
 );c.if
(setvar "cmdecho" 1)

 (prin1)
);c.defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Copyright ©2004 by draftteam software                           
;;; All rights reserved                                             
;;;                                                                 
;;; DRAFTTEAM PROVIDES THIS PROGRAM SOFTWARE "AS IS" AND WITH ALL   
;;; FAULTS. DRAFTTEAM SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY   
;;; OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. DRAFTTEAM   
;;; SOFTWARE DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL
;;; BE UNINTERRUPTED OR ERROR FREE.                                 
;;;                                                                 
;;; code: José Luis García                                         
;;;                                                                 
;;; http://www.draftteam.com                                       
;;;-----------------------------------------------------------------

;;-------------------------------------------
;;  dibuja un texto en la pantalla           
;;-------------------------------------------
(defun XDraw_Txt (al p cad col codh codv)
 (setq EntTxt
  (entmakex
   (list '(0 . "TEXT");'(8 . "ARQ_Areas_C_Cuadros")
     (cons 62 col)
          (cons 40 al)
          (cons 1 cad)
          '(50 . 0.0) '(41 . 1.0)
          (cons 7 (getvar "TEXTSTYLE"))
          (cons 72 codh)
          (cons 10 p)
          (cons 11 p)
          (cons 73 codv)
   );c.list
  );c.entmk
 );c.setq
);c.defun

;;-------------------------------------------
;; conjunto de seleccion a lista de entidades
;;-------------------------------------------
(defun SSToList (ss / ssl n)
 (if (and ss (= (type ss) 'PICKSET))
  (repeat (1+ (setq n (1- (sslength ss))))
   (setq ssl (cons (ssname ss n) ssl) n (1- n))
  );c.repeat
 )
 ssl
);c.defun

(defun dxf (n eg) (cdr (assoc n eg)))

;----------------------------------------------------
;lista de vertices de LWPOLYLINE                     
;----------------------------------------------------
(defun GetVertPol (Pol / LPtspol)
 (mapcar 'cdr
  (vl-remove-if (function (lambda (x) (/= (car x) 10))) (entget Pol)))
)

;;-------------------------------------------------------------------------------
;;;                    Centroide de LWPOLILINE                                   
;;-------------------------------------------------------------------------------
(defun CentroidePol (Poliline / lVertices Centroide)
  (setq lVertices (GetVertPol Poliline)
        Centroide (trans (CentroidLisPts lVertices) 0 1) )
) ;_ fin de defun

;;---------------------------- CentroidLisPts -----------------------------------
;; (Centroide de lista de puntos obtenidos de Polilinea)                         
;;-------------------------------------------------------------------------------
(defun CentroidLisPts  (vlist /   segno n   ttl_area basex basey p1   p2 x1 x2 y1 y2 t_x t_y
         t_area t_xm t_ym r_x r_y r_area   r_xm r_ym Mx My)
 (setq vlist   (append vlist (list (car vlist)))
       segno   (1- (length vlist))
       n   0
       Ttl_Area   0.0
       Mx   0.0
       My   0.0
       basex   (car (nth 0 vlist))
       basey   (cadr (nth 0 vlist)))
 (repeat segno
  (setq   p1    (nth n vlist)
   p2    (nth (1+ n) vlist)
   x1    (car p1)
   y1    (cadr p1)
   x2    (car p2)
   y2    (cadr p2)
   t_x    (- (* (+ x2 x2 x1) 0.333333) basex)
   t_y    (- (* (+ y1 y1 y2) 0.333333) basey)
   t_area    (* (- y2 y1) (- x2 x1) 0.5)
   t_xm    (* t_area t_x)
   t_ym    (* t_area t_y)
   r_x    (- (/ (+ x1 x2) 2) basex)
   r_y    (- (/ (+ basey y1) 2) basey)
   r_area    (* (- x2 x1) (- y1 basey))
   r_xm    (* r_area r_x)
   r_ym    (* r_area r_y)
   Ttl_Area (+ Ttl_Area t_area r_area)
   Mx    (+ Mx t_xm r_xm)
   My    (+ My t_ym r_ym)
   n    (1+ n)) ;_ c. setq
  ) ;_ c. repeat
 (list (+ (/ Mx Ttl_Area) basex) (+ (/ My Ttl_Area) basey))) ;c. defun
(princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 

thanks¡¡¡¡¡

3 REPLIES 3
Message 2 of 4
gpcattaneo
in reply to: andresep82

Converting (command) calls to (command-s) is recommended in AutoCAD 2015

Message 3 of 4
hmsilva
in reply to: andresep82


@andresep82 wrote:

hello again,

 

I am trying the new version of autocad,and   this lips don´t work,why?

 ...


Do you get any error message?

 

Henrique

EESignature

Message 4 of 4
andresep82
in reply to: gpcattaneo

yeah¡¡¡¡  Smiley Very Happy   thanks¡¡¡

 

 

 

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost