LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Ver el tema anterior Ver el tema siguiente Ir abajo

LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por stg el Mar Abr 18, 2017 4:22 pm

Hola compañeros;

Existe algún comando o Lisp que convierta los objetos y elementos de un bloque a capa "0" y color "porcapa"?? (me encuentro con dibujos que contienen bloque y en si mismo también otros bloques y con contenido de objetos a distintas capa y distintos colores, etc.... necesitaría poder convertir todos estos elementos a la capa "0" y color "porcapa")

Otra duda que os planteo es seleccionar todo un dibujo y convertirlo en color "porcapa" (esta operación hasta ahora la podía realizar mediante una selección manual por ventana y posteriormente indicar en sus propiedades el color "porcapa", pero no se porque me falla y lo tengo que solucionar mediante selecciones parciales del dibujo....con lo cual se eterniza)

Mil gracias y saludos a todos!

stg

Mensajes : 6
Fecha de inscripción : 12/04/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por saulo2016 el Mar Abr 18, 2017 5:11 pm

Haber dejame ver si te entendi.....

Tienes en un dibujo muchos bloques y cada bloque tiene diferentes layers, lo que tu quieres es cambiar tooooodos los layers de tooodos los bloques a (por ejemplo) layer 0.......¿entendi bien?
avatar
saulo2016

Mensajes : 117
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por saulo2016 el Mar Abr 18, 2017 5:43 pm

sin explotar los bloques...


creo que eso es lo que tu quieres.....
avatar
saulo2016

Mensajes : 117
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por saulo2016 el Mar Abr 18, 2017 5:45 pm

si estoy en lo correcto entonces copiate este codigo:

Código:
(defun c:norm (/ *error* adoc lst_layer func_restore-layers)
  (defun *error* (msg)
    (func_restore-layers)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun func_restore-layers ()
    (foreach item lst_layer
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
        '(lambda ()
           (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
           ) ;_ end of lambda
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for item (vla-get-layers adoc)
    (setq lst_layer (cons (list item
                                (cons "lock" (vla-get-lock item))
                                (cons "freeze" (vla-get-freeze item))
                                ) ;_ end of list
                          lst_layer
                          ) ;_ end of cons
          ) ;_ end of setq
    (vla-put-lock item :vlax-false)
    (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
    ) ;_ end of vlax-for
  (vlax-for blk (vla-get-blocks adoc)
    (if (and (equal (vla-get-islayout blk) :vlax-false)
             (equal (vla-get-isxref blk) :vlax-false)
             ) ;_ end of and
      (progn
        (vlax-for subent blk
          (vla-put-layer subent "0")
          (vla-put-color subent 0)
          (vla-put-lineweight subent aclnwtbyblock)
          (vla-put-linetype subent "byblock")
          ) ;_ end of vlax-for
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of vlax-for
  (func_restore-layers)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

y nos cuentas como te fué...
avatar
saulo2016

Mensajes : 117
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por saulo2016 el Mar Abr 18, 2017 6:04 pm

Ahora si es que entendi bien tu segunda pregunta entonces se me ocurre un pequeño truco...

Primero.- Copiate este otro CODIGO :

Código:
(defun C:IMP (/ SLCT CDATE BNAME)
  (setvar "cmdecho" 0)
  (princ "\nSelect items to IMPLODE: ")
  (setq SLCT (ssget))
  (setq
      CDATEX (rtos (getvar "cdate") 2 9)
      BNAME  (strcat (substr CDATEX 10 8))
  )
  (command "_block" BNAME "0,0" SLCT "")
  (command
      "_insert" BNAME "0,0" "" "" ""
  )
)

Con él vas a convertirte tooooodo lo que selecciones en BLOQUE, luego utilizas el que te postee anteriormente y los acambias a LAYER 0.....

No sé si es eso lo que necesitas....es lo que se me ocurre de momento....

Habra alguien que te de posiblemente una mejor solucion.....

Ahi nos cuentas.
avatar
saulo2016

Mensajes : 117
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por saulo2016 el Mar Abr 18, 2017 6:15 pm

Una mas seria el comando SELECTSIMILAR y asi puedes seleccionar por tipos de objetos y cambiarlos todos.


Otra seria utilizar el Quick Select...este lo encuentras en el cuadro de dialogo de PROPERTIES, en la esquina superior derecha, asi como te lo muestro en la imagen.



No sé si te pude ayudar en algo.
avatar
saulo2016

Mensajes : 117
Fecha de inscripción : 17/03/2016
Edad : 51
Localización : Monterrey, Nuevo León, Mexico

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por Marco Jacinto el Mar Abr 18, 2017 9:26 pm

El comando Laytrans hace lo que necesitas, tambien el comando SetBylayer, el cual tiene diferentes opciones.

Marco Jacinto

Mensajes : 20
Fecha de inscripción : 12/08/2016

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por IvanRomero el Dom Ago 06, 2017 4:25 am

stg escribió:Existe algún comando o Lisp que convierta los objetos y elementos de un bloque a capa "0" y color "porcapa"?? (me encuentro con dibujos que contienen bloque y en si mismo también otros bloques y con contenido de objetos a distintas capa y distintos colores, etc.... necesitaría poder convertir todos estos elementos a la capa "0" y color "porcapa")


FIXBLOCK LISP CODE... PARA LOS BLOQUES:

Código:
(defun C:FixBlock (/ ss cnt idx blkname donelist Grp Update)
  (defun Grp (gc el) (cdr (assoc gc el)))
  (defun Update (bname / ename elist)
    (setq ename (tblobjname "BLOCK" bname))
    (if
      (and ename (zerop (logand 52 (Grp 70 (entget ename '("*"))))))
      (progn
        (while ename
          (setq elist (entget ename '("*"))
                elist (subst '(8 . "0") (assoc 8 elist) elist)
                elist (if (assoc 62 elist)
                        (subst '(62 . 0) (assoc 62 elist) elist)
                        (append elist '((62 . 0)))))
          (entmake elist)
          (setq ename (entnext ename)))
        (if (/= "ENDBLK" (Grp 0 elist))
          (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
        'T))
  )
  (if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)
    (princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
    (progn
      (if
        (progn
          (princ "\nPress <Enter> to fix all defined blocks\n")
          (setq cnt 0
                ss (ssget '((0 . "INSERT")))))
        (progn
          (setq idx (sslength ss))
          (while (>= (setq idx (1- idx)) 0)
            (if (not (member (setq blkname (Grp 2 (entget (ssname ss idx)))) donelist))
              (progn
                (if (Update blkname) (setq cnt (1+ cnt)))
                (setq donelist (cons blkname donelist))))))
        (while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))
          (if (Update blkname) (setq cnt (1+ cnt)))))
      (princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))
  (princ)
)
;end

El codigo anterior realiza justo lo que pides con los bloques.
1:-Redefine todos o selecciona los  bloques para que todas las entidades están en capa '0' (cero),  Pero el color es by block.



All_BYL LISP CODE...  PARA TODO EN BY LAYER :

Código:
(vl-load-com)
(vlr-remove-all)
(setq atb_autoCad (vlax-get-acad-object)
      atb_activeDocument (vlax-get-property atb_autoCad 'activeDocument)
      atb_menuGroups (vlax-get-property atb_autoCad 'menuGroups)
      atb_blocks (vlax-get-property atb_activeDocument 'blocks)
      atb_dimStyles (vlax-get-property atb_activeDocument 'dimStyles)
      atb_layers (vlax-get-property atb_activeDocument 'layers)
      atb_linetypes (vlax-get-property atb_activeDocument 'linetypes)
      atb_modelSpace (vlax-get-property atb_activeDocument 'modelSpace)      
      atb_paperSpace (vlax-get-property atb_activeDocument 'paperSpace)
      atb_plotConfigurations (vlax-get-property atb_activeDocument 'plotConfigurations)
      atb_plot (vlax-get-property atb_activeDocument 'plot)
      atb_preferences (vlax-get-property atb_autoCad 'preferences)
      atb_textStyles (vlax-get-property atb_activeDocument 'textStyles)
      atb_userCoordinateSystems (vlax-get-property atb_activeDocument 'userCoordinateSystems)
      atb_utility (vlax-get-property atb_activeDocument 'utility)
      ht_views (vlax-get-property atb_activeDocument 'views)
      atb_viewports (vlax-get-property atb_activeDocument 'viewports)
      atb_space atb_modelSpace
)

(defun atb_bylayer ()
  (vlax-for a atb_blocks
    (if (= (vlax-get-property a 'isXref) :vlax-false)
      (progn
        (vlax-for b a
          (vlax-put-property b 'color acByLayer)
  (vlax-put-property b 'lineweight acLnWtByLayer)
  (if (= (vlax-get-property b 'objectName) "AcDbBlockReference")
            (progn
              (if (= (vlax-get-property b 'hasAttributes) :vlax-true)
        (progn
          (setq ht_attv (vlax-invoke-method b 'getAttributes)
                ht_attl (vlax-safearray->list (vlax-variant-value ht_attv))
          )
          (foreach c ht_attl
                    (vlax-put-property c 'color acByLayer)
    (vlax-put-property c 'lineweight acLnWtByLayer)
  )
 )
      )
    )
  )
  (if (= (vlax-get-property b 'objectName) "AcDbMText")
            (progn
      (setq ht_string (vlax-get-property b 'textString)
            ht_count 1 ht_mod nil
      )
      (while (<= ht_count (strlen ht_string))
 (setq ht_one (substr ht_string ht_count 4)
      ht_two (substr ht_string ht_count 5)
      ht_three (substr ht_string ht_count 6)
 )
 (cond
  ((wcmatch ht_one "\\C*;")
    (setq ht_string (strcat (substr ht_string 1 (1- ht_count)) (substr ht_string (+ ht_count 4)))
  ht_count 0 ht_mod T
    )
  )
  ((wcmatch ht_two "\\C*;")
    (setq ht_string (strcat (substr ht_string 1 (1- ht_count)) (substr ht_string (+ ht_count 5)))
  ht_count 0 ht_mod T
    )
  )
  ((wcmatch ht_three "\\C*;")
    (setq ht_string (strcat (substr ht_string 1 (1- ht_count)) (substr ht_string (+ ht_count 6)))
  ht_count 0 ht_mod T
    )
  )
 )
        (setq ht_count (1+ ht_count))
      )
      (if ht_mod
 (vlax-put-property b 'textString ht_string)
      )
    )
  )
 )
      )
    )
  )
  (princ)
)

(defun c:ALL_BY()
  (atb_bylayer)
)

;Command reactor 1
(defun ht_commandStart (ht_reactor ht_command)
  (if (= (nth 0 ht_command) "PLOT")
    (progn
      (setvar "xclipframe" 0)
      (setq ht_ss nil)
      (if (= (getvar "cvport") 1)
        (setq ht_ss (ssget "x" '((0 . "insert") (2 . "pdt") (67 . 1))))
        (setq ht_ss (ssget "x" '((0 . "insert") (2 . "pdt") (67 . 0))))
      )
      (if ht_ss
     (progn
          (htpdt)
          (princ)
     )
      )
    )
  )  
)

;Command reactor 2
(defun ht_commandEnd (ht_reactor ht_command)
  (if
    (and
       (not (= (getvar "userr1") 0.0))
       (not (= (getvar "userr3") 0.0))
    )
    (progn
      (if
        (and
          (= (getvar "tilemode") 1)
          (= (nth 0 ht_command) "LTSCALE")
 )
        (setvar "userr2" (/ (* (getvar "ltscale") (getvar "userr1")) (getvar "userr3")))
      )    
      (if
        (and
          (= (getvar "tilemode") 0)
          (= (nth 0 ht_command) "LTSCALE")
        )
        (setvar "userr2" (getvar "LTSCALE"))
      )  
    )
  )  
  (princ)
)

;Layout changed reactor
(defun ht_layoutSwitch (ht_reactor ht_layout)
  (if
    (and
       (not (= (getvar "userr1") 0.0))
       (not (= (getvar "userr2") 0.0))
       (not (= (getvar "userr3") 0.0))
    )
    (if (= (nth 0 ht_layout) "Model")
      (progn
        (setvar "ltscale" (/ (* (getvar "userr3") (getvar "userr2")) (getvar "userr1")))
        (setvar "dimscale" (/ (getvar "userr3") (getvar "userr1")))
      )
      (progn
        (setvar "ltscale" (getvar "userr2"))
        (setvar "dimscale" 1)
      )
    )
  )
  (princ)
)

;System variable Reactor
(defun ht_sysVar (ht_reactor ht_variable)
  (if
    (and
       (not (= (getvar "userr1") 0.0))
       (not (= (getvar "userr2") 0.0))
       (not (= (getvar "userr3") 0.0))
    )
    (progn
      (if
        (and
          (= (getvar "tilemode") 1)
          (or
    (= (nth 0 ht_variable) "USERR1")
    (= (nth 0 ht_variable) "USERR2")
    (= (nth 0 ht_variable) "USERR3")
          )
        )
        (progn
          (setvar "ltscale" (/ (* (getvar "userr3") (getvar "userr2")) (getvar "userr1")))
          (setvar "dimscale" (/ (getvar "userr3") (getvar "userr1")))
          (vlax-invoke-method atb_activeDocument 'regen acActiveViewport)
        )
      )    
      (if
        (and
          (= (getvar "tilemode") 0)
          (= (nth 0 ht_variable) "USERR2")
        )
        (setvar "ltscale" (getvar "userr2"))
      )  
    )
  )
  (if (= (nth 0 ht_variable) "MEASUREMENT")
    (if (= (getvar "measurement") 0)
      (progn
        (setvar "userr2" 10)
        (setvar "userr1" 1)
      )
      (progn
        (setvar "userr2" 1)
        (setvar "userr1" 1000)
      )
    )
  )
  (princ)
)


;Close Reactor
(defun ht_close (ht_reactor ht_list)
  (setq ht_mx nil)
  (vlax-for a atb_blocks
    (if (= (vlax-get-property a 'isLayout) :vlax-true)
      (progn
        (setq ht_layout (vlax-get-property a 'layout))
 (if (= (vlax-get-property ht_layout 'name) "MXChange")
  (progn
            (vlax-invoke-method ht_layout 'delete)
    (setq ht_mx T)
  )
 )
      )
    )
  )
  (if ht_mx
    (progn
      (vlax-for a atb_modelSpace
 (progn
  (if (= (vlax-get-property a 'objectName) "AcDbText")
    (progn
              (vlax-put-property a 'scaleFactor 1.0)
      (if (= (vlax-get-property a 'textString) "R=æ")
        (vlax-put-property a 'textString "STRAIGHT")
      )
      (if (= (vlax-get-property a 'textString) "D")
        (vlax-put-property a 'textString "")
      )
      (if (= (vlax-get-property a 'textString) "0.0%")
        (vlax-put-property a 'textString "")
      )
      (if (= (vlax-get-property a 'textString) "0.1%")
        (vlax-put-property a 'textString "")
      )
      (if (= (vlax-get-property a 'textString) "0.2%")
        (vlax-put-property a 'textString "")
      )
      (if (= (vlax-get-property a 'textString) "0.3%")
        (vlax-put-property a 'textString "")
      )
      (if (= (vlax-get-property a 'textString) "0.4%")
        (vlax-put-property a 'textString "")
      )      
      (if (= (vlax-get-property a 'textString) "****%")
        (vlax-put-property a 'textString "")
      )
    )
          )
 )
      )
      (vlax-for a atb_textStyles
        (if (= (substr (vlax-get-property a 'name) 1 3) "MSL")
          (vlax-put-property a 'fontFile "arial")
        )
      )
      (vlax-put-property atb_activeDocument 'activespace acModelSpace)
      (vlax-invoke-method atb_autoCad 'zoomExtents)
      (vlax-invoke-method atb_activeDocument 'save)
    )
  )
)

;Initiate reactors
(vlr-command-reactor nil '((:vlr-commandWillStart . ht_commandStart))) ;Plot reactor
;(vlr-command-reactor nil '((:vlr-commandEnded . ht_commandEnd)))
(vlr-miscellaneous-reactor nil '((:vlr-layoutSwitched . ht_layoutSwitch)))
(vlr-sysvar-reactor nil '((:vlr-sysVarChanged . ht_sysVar)))
(vlr-dwg-reactor nil '((:vlr-beginClose . ht_close)))

;Modemacro
(setvar "modemacro" ".")
(setvar "modemacro"
  (strcat
    "$(if,$(=,$(getvar,measurement),0),English,Metric)"
    "$(if,$(!=,$(getvar,cvport),1),"
    "  Unit=$(if,$(=,$(getvar,userr1),1),Millimetres,Metres)"
    "  Scale=1:"
    "$(substr,$(getvar,userr3),1))"
    "  Ltscale="
    "$(substr,$(getvar,ltscale),1)"
   )
)

;a Space     atb_modelSpace
;b Closed    :vlax-false
;c Color     acBylayer
;d Elevation 0.0
;e Layer     "0"
;f Linetype  "BYLAYER"
;g Vertexes  ht_pntlist
;h Bulges    ht_bulgelist
(defun ht_makeLightWeightPolyline (a b c d e f g h)
  (setq ht_ubound (- (* (length g) 2) 1)
 ht_coordinates (vlax-make-safearray vlax-vbDouble (cons 0 ht_ubound))
 ht_count 0
  )
  (foreach i g
    (setq ht_pnt i
  ht_pntx (nth 0 ht_pnt)
  ht_pnty (nth 1 ht_pnt)
    )
    (vlax-safearray-put-element ht_coordinates ht_count ht_pntx)
    (vlax-safearray-put-element ht_coordinates (1+ ht_count) ht_pnty)
    (setq ht_count (+ ht_count 2))
  )
  (setq ht_newLightWeightPolyline (vlax-invoke-method a 'addLightWeightPolyline (vlax-make-variant ht_coordinates)))
  (vlax-put-property ht_newLightWeightPolyline 'closed b)
  (vlax-put-property ht_newLightWeightPolyline 'color c)
  (vlax-put-property ht_newLightWeightPolyline 'elevation d)  
  (vlax-put-property ht_newLightWeightPolyline 'layer e)
  (vlax-put-property ht_newLightWeightPolyline 'linetype f)
  (setq ht_total (1- ht_count)
 ht_count 0
  )
  (while (< ht_count (length h))
    (vlax-invoke-method ht_newLightWeightPolyline 'setBulge ht_count (nth ht_count h))
    (setq ht_count (1+ ht_count))
  )
)

;a Space    atb_modelSpace
;b Closed   :vlax-false
;c Color    acBylayer
;d Layer    "0"
;e Linetype "BYLAYER"
;f Type     acSimple3DPoly
;g Vertexes ht_pntlist
(defun ht_make3DPolyline (a b c d e f g)
  (setq ht_ubound (- (* (length g) 3) 1)
 ht_coordinates (vlax-make-safearray vlax-vbDouble (cons 0 ht_ubound))
 ht_count 0
  )
  (foreach h g
    (setq ht_pnt h
  ht_pntx (nth 0 ht_pnt)
  ht_pnty (nth 1 ht_pnt)
  ht_pntz (nth 2 ht_pnt)
    )
    (if (not ht_pntz)
      (setq ht_pntz 0.0)
    )
    (vlax-safearray-put-element ht_coordinates ht_count ht_pntx)
    (vlax-safearray-put-element ht_coordinates (1+ ht_count) ht_pnty)
    (vlax-safearray-put-element ht_coordinates (+ ht_count 2) ht_pntz)
    (setq ht_count (+ ht_count 3))
  )
  (setq ht_new3DPolyline (vlax-invoke-method a 'add3DPoly (vlax-make-variant ht_coordinates)))
  (vlax-put-property ht_new3DPolyline 'closed b)
  (vlax-put-property ht_new3DPolyline 'color c)
  (vlax-put-property ht_new3DPolyline 'layer d)
  (vlax-put-property ht_new3DPolyline 'linetype e)
  (vlax-put-property ht_new3DPolyline 'type f)
)

(defun ht_ps->ms ()
  (if (= (getvar "tilemode") 0)
    (progn
      (vlax-put-property atb_activeDocument 'mspace :vlax-false)
      (setq ht_ss (ssget "x" '((67 . 0) (-3 ("HT ps-ms pViewport"))))
    atb_paperSpace (vlax-get-property atb_activeDocument 'paperSpace)
      )
      (if ht_ss
 (progn
          (setq ht_ssn (1- (sslength ht_ss)))
          (while (> ht_ssn -1)
            (setq ht_ename (ssname ht_ss ht_ssn)
  ht_ssn (1- ht_ssn)
    )
    (entdel ht_ename)
  )
 )
      )
      (vlax-for a atb_paperSpace
        (if (= (vlax-get-property a 'objectName) "AcDbViewport")
          (progn
            (setq ht_obj a      
          ht_sc (vlax-get-property ht_obj 'customScale)
                  ht_psw (vlax-get-property ht_obj 'width)
                  ht_psh (vlax-get-property ht_obj 'height)
          ht_vt (vlax-get-property ht_obj 'twistAngle)
                  ht_msw (/ ht_psw ht_sc)
                  ht_msh (/ ht_psh ht_sc)
          ht_ename (vlax-vla-object->ename ht_obj)
          ht_dxf (entget ht_ename)
          ht_dcs (cdr (assoc 12 ht_dxf))
          ht_col (cdr (assoc 62 ht_dxf))
                  ht_id (cdr (assoc 69 ht_dxf))
  ht_scale (read (rtos (/ 1.0 ht_sc) 2 4))
    )
    ;(princ ht_scale)
    (if (= (getvar "userr1") 0.0)
      (setq ht_name (rtos ht_id 2 0))
            (setq ht_name (rtos (* ht_scale (getvar "userr1")) 2 0))
    )
    (if (not ht_col)
              (setq ht_col acBylayer)
            )
            (if (not (= ht_id 1))
      (progn
 (vlax-invoke-method ht_obj 'display :vlax-true)
 (vlax-put-property atb_activeDocument 'mspace :vlax-true)
 (setvar "cvport" ht_id)
 (setvar "ucsview" 1)
 (setvar "cmdecho" 0)
 (command "ucs" "v")
 (if (tblsearch "ucs" ht_name)
  (command "ucs" "s" ht_name "y")
  (command "ucs" "s" ht_name)
 )
                (command "view" "s" ht_name)
 (setvar "cmdecho" 1)
 (setq ht_cen ht_dcs)
 (setq ht_vt (- (* pi 2.0) ht_vt)
                      ht_cen (list (nth 0 ht_cen) (nth 1 ht_cen))
                      ht_tm (polar ht_cen (* pi 0.5) (* ht_msh 0.5))
                      ht_p1 (polar ht_tm pi (* ht_msw 0.5))
                      ht_p2 (polar ht_tm 0.0 (* ht_msw 0.5))
                      ht_p3 (polar ht_p2 (* pi 1.5) ht_msh)
                      ht_p4 (polar ht_p1 (* pi 1.5) ht_msh)
      ht_p1m (trans ht_p1 2 0)
      ht_p2m (trans ht_p2 2 0)
      ht_p3m (trans ht_p3 2 0)
      ht_p4m (trans ht_p4 2 0)
              ht_pntlist (list ht_p1m ht_p2m ht_p3m ht_p4m)
 )      
        (vlax-put-property atb_activeDocument 'mspace :vlax-false)
        (ht_make3DPolyline atb_modelSpace :vlax-true ht_col "DEFPOINTS" "BYLAYER" acSimple3DPoly ht_pntlist)
 ;(regapp "HT ps-ms pViewport")
 ;(setq ht_dxf (entget (vlax-vla-object->ename ht_new3DPolyline))
 ;      ht_exdata '((-3 ("HT ps-ms pViewport" (1000 . "3DPolyline"))))
 ;      ht_newDxf (append ht_dxf ht_exdata)
 ;)
                ;(entmod ht_newDxf)
      )
    )
  )
 )
      )
      (vlax-put-property atb_activeDocument 'activeSpace acModelSpace)
    )
  )
  (princ)
)

(defun atb_bylayer ()
  (vlax-for a atb_blocks
    (if (= (vlax-get-property a 'isXref) :vlax-false)
      (progn
        (vlax-for b a
          (vlax-put-property b 'color acByLayer)
  (vlax-put-property b 'lineweight acLnWtByLayer)
  (if (= (vlax-get-property b 'objectName) "AcDbBlockReference")
            (progn
              (if (= (vlax-get-property b 'hasAttributes) :vlax-true)
        (progn
          (setq ht_attv (vlax-invoke-method b 'getAttributes)
                ht_attl (vlax-safearray->list (vlax-variant-value ht_attv))
          )
          (foreach c ht_attl
                    (vlax-put-property c 'color acByLayer)
    (vlax-put-property c 'lineweight acLnWtByLayer)
  )
 )
      )
    )
  )
 )
      )
    )
  )
  (princ)
)

Ahora que si lo que usted necesisata es poner todo en BYLAYER, El codigo anterior convierte todo el dibujo a BYLAYER.. INCLUSO LOS BLOQUES


BYLAY LISP CODE... PARA SELECCIONAR ENTIDADES A CONVERTIR A BYLAYER:

Código:
(defun c:Bylay (/ )
(apply '(lambda ()

(defun *error* (msg)
(prin1 msg))

(setq uecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\nDesigne eleemntos a cambiar BYLAYER :")
(setq ps1 (ssadd))
(setq ps1 (ssget))
(command "CHANGE" ps1 "" "P" "C" "BYLAYER" "LT" "BYLAYER" "")
(setvar "cmdecho" uecho)
)'())
);end

Por ultimo si solo necesita cambiar unas entidades a BYLAYER.. Este pequeño código hace el trabajo deseado.
 Espero haber ayudados. Saludos

IvanRomero

Mensajes : 2
Fecha de inscripción : 05/08/2017

Ver perfil de usuario

Volver arriba Ir abajo

Re: LISP (SELECCIÓNAR TODO Y CONVERTIR TODO COLOR PORCAPA), LISP (BLOQUES COLOR PORCAPA Y CAPA 0)

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.