Community
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¡¡¡¡¡
Solved! Go to Solution.
Solved by gpcattaneo. Go to Solution.
Converting (command) calls to (command-s) is recommended in AutoCAD 2015
@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