TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: handasa on February 04, 2016, 03:08:48 PM

Title: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 04, 2016, 03:08:48 PM
greetings every body,
i have this lisp code
Code - Auto/Visual Lisp: [Select]
  2. (defun c:COMBINELAYERS(/ doc blocks blk eo layers lay)
  3. ;CHANGE BY LAYER COLOR TO OVERRIDE COLOR
  4.   ;; Get the ActiveX object of the current dwg
  6.         blocks (vla-get-Blocks doc) ;Get the blocks collection
  7.         layers (vla-get-Layers doc) ;Get the layers collection
  8.   ) ;_ end of setq
  9.  
  10.   ;; Step through all blocks (including Model Space & Layouts)
  11.   (vlax-for blk blocks
  12.     ;; Step through all contained entities in block
  13.     (vlax-for eo blk
  14.       ;; Get the layer the entity is placed on
  15.       (setq lay (vla-Item layers (vla-get-Layer eo)))
  16.       (vla-put-Layer eo (getvar "CLAYER")) ;Change the entity to the current layer
  17.       (if (= (vla-get-Color eo) 256)
  18.         ;;If its colour bylayer, change it to overridden color to match
  19.         (vla-put-Color eo (vla-get-color lay))
  20.       ) ;_ end of if
  21.       (if (= (strcase (vla-get-Linetype eo)) "BYLAYER")
  22.         ;;If its linetype bylayer, change it to overridden linetype to match
  23.         (vla-put-Linetype eo (vla-get-Linetype lay))
  24.       ) ;_ end of if
  25.       (if (= (vla-get-Lineweight eo) -1)
  26.         ;;If its lineweight bylayer, change it to overridden lineweigth to match
  27.         (vla-put-Lineweight eo (vla-get-Lineweight lay))
  28.       ) ;_ end of if
  29.     ) ;_ end of vlax-for
  30.   ) ;_ end of vlax-for
  31.   (princ)
  32. ) ;_ end of defun


which apply its task to the whole drawing objects ..

i need to apply this lisp to the selected objects only

any suggestions ?
thanks in advance  8-)
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: roy_043 on February 05, 2016, 05:32:43 AM
Welcome to The Swamp.

Try this:
Code - Auto/Visual Lisp: [Select]
  2.  
  3. (defun _Conv_Pickset_To_EnameList (ss / i ret)
  4.   (if ss
  5.     (repeat (setq i (sslength ss))
  6.       (setq ret (cons (ssname ss (setq i (1- i))) ret))
  7.     )
  8.   )
  9. )
  10.  
  11. (defun c:CombineLayers (/ clyr doc lyrs ss)
  12.   (if (setq ss (ssget))
  13.     (progn
  15.       (if (= (logand (getvar 'undoctl) 8) 8)
  16.         (vla-endundomark doc)
  17.       )
  18.       (vla-startundomark doc)
  19.       (setq lyrs (vla-get-layers doc))
  20.       (setq clyr (getvar 'clayer))
  21.       (mapcar
  22.         '(lambda (obj / lyr)
  23.           (setq lyr (vla-item lyrs (vla-get-layer obj)))
  24.           (vla-put-layer obj clyr)
  25.           (if (= 256 (vla-get-color obj))
  26.             (vla-put-color obj (vla-get-color lyr))
  27.           )
  28.           (if (= "BYLAYER" (strcase (vla-get-linetype obj)))
  29.             (vla-put-linetype obj (vla-get-linetype lyr))
  30.           )
  31.           (if (= -1 (vla-get-lineweight obj))
  32.             (vla-put-lineweight obj (vla-get-lineweight lyr))
  33.           )
  34.         )
  35.         (mapcar 'vlax-ename->vla-object (_Conv_Pickset_To_EnameList ss))
  36.       )
  37.       (vla-endundomark doc)
  38.     )
  39.   )
  40.   (princ)
  41. )
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 05, 2016, 09:15:24 AM
roy,the original lisp apply its effect to blocks sub entities ... the modified one doesn't ...thanks
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: roy_043 on February 05, 2016, 11:41:40 AM
Quote from: handasa on February 05, 2016, 09:15:24 AM
roy,the original lisp apply its effect to blocks sub entities ... the modified one doesn't ...thanks
Yes, I know but that is what you have asked for:
Quote from: handasa on February 04, 2016, 03:08:48 PM
i need to apply this lisp to the selected objects only
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: roy_043 on February 05, 2016, 02:15:24 PM
Here is the revised code. Mind that the code does not handle the special behaviour of nested entities on layer "0".
Code - Auto/Visual Lisp: [Select]
  2.  
  3. (defun _Conv_Pickset_To_EnameList (ss / i ret)
  4.   (if ss
  5.     (repeat (setq i (sslength ss))
  6.       (setq ret (cons (ssname ss (setq i (1- i))) ret))
  7.     )
  8.   )
  9. )
  10.  
  11. (defun c:CombineLayers (/ N_Modify cLyrNme blkLst blks doc lyrs ss)
  12.  
  13.   (defun N_Modify (obj / blk lyr)
  14.     (setq lyr (vla-item lyrs (vla-get-layer obj)))
  15.     (vla-put-layer obj cLyrNme)
  16.     (if (= 256 (vla-get-color obj))
  17.       (vla-put-color obj (vla-get-color lyr))
  18.     )
  19.     (if (= "BYLAYER" (strcase (vla-get-linetype obj)))
  20.       (vla-put-linetype obj (vla-get-linetype lyr))
  21.     )
  22.     (if (= -1 (vla-get-lineweight obj))
  24.     )
  25.     (if
  26.       (and
  27.         (vlax-property-available-p obj 'hasattributes)
  28.         (= :vlax-true (vla-get-hasattributes obj))
  29.       )
  30.       (foreach att (vlax-invoke obj 'getattributes)
  31.         (N_Modify att)
  32.       )
  33.     )
  34.     (if
  35.       (and
  36.         (= "AcDbBlockReference" (vla-get-objectname obj))
  37.         (not (vl-position (setq blk (vla-item blks (vla-get-name obj))) blkLst))
  38.       )
  39.       (setq blkLst (append blkLst (list blk)))
  40.     )
  41.   )
  42.  
  43.   (if (setq ss (ssget))
  44.     (progn
  46.       (if (= (logand (getvar 'undoctl) 8) 8)
  47.         (vla-endundomark doc)
  48.       )
  49.       (vla-startundomark doc)
  50.       (setq lyrs (vla-get-layers doc))
  51.       (setq blks (vla-get-blocks doc))
  52.       (setq cLyrNme (getvar 'clayer))
  53.       (foreach obj (mapcar 'vlax-ename->vla-object (_Conv_Pickset_To_EnameList ss))
  54.         (N_Modify obj)
  55.       )
  56.       (while blkLst
  57.         (if (= :vlax-false (vla-get-isxref (car blkLst)))
  58.           (vlax-for obj (car blkLst)
  59.             (N_Modify obj)
  60.           )
  61.         )
  62.         (setq blkLst (cdr blkLst))
  63.       )
  64.       (vla-endundomark doc)
  65.     )
  66.   )
  67.   (princ)
  68. )
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 05, 2016, 02:32:48 PM
great job ...
that's what i need ...
thanks alot, roy
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: roy_043 on February 06, 2016, 04:44:34 AM
The code in my previous post could process the same block twice.
New code:
Code - Auto/Visual Lisp: [Select]
  2.  
  3. (defun _Conv_Pickset_To_EnameList (ss / i ret)
  4.   (if ss
  5.     (repeat (setq i (sslength ss))
  6.       (setq ret (cons (ssname ss (setq i (1- i))) ret))
  7.     )
  8.   )
  9. )
  10.  
  11. (defun c:CombineLayers (/ N_Modify cLyrNme blkLst blks doc i lyrs ss)
  12.  
  13.   (defun N_Modify (obj / blk lyr)
  14.     (setq lyr (vla-item lyrs (vla-get-layer obj)))
  15.     (vla-put-layer obj cLyrNme)
  16.     (if (= 256 (vla-get-color obj))
  17.       (vla-put-color obj (vla-get-color lyr))
  18.     )
  19.     (if (= "BYLAYER" (strcase (vla-get-linetype obj)))
  20.       (vla-put-linetype obj (vla-get-linetype lyr))
  21.     )
  22.     (if (= -1 (vla-get-lineweight obj))
  24.     )
  25.     (if
  26.       (and
  27.         (vlax-property-available-p obj 'hasattributes)
  28.         (= :vlax-true (vla-get-hasattributes obj))
  29.       )
  30.       (foreach att (vlax-invoke obj 'getattributes)
  31.         (N_Modify att)
  32.       )
  33.     )
  34.     (if
  35.       (and
  36.         (= "AcDbBlockReference" (vla-get-objectname obj))
  37.         (not (vl-position (setq blk (vla-item blks (vla-get-name obj))) blkLst))
  38.       )
  39.       (setq blkLst (append blkLst (list blk)))
  40.     )
  41.   )
  42.  
  43.   (if (setq ss (ssget))
  44.     (progn
  46.       (if (= (logand (getvar 'undoctl) 8) 8)
  47.         (vla-endundomark doc)
  48.       )
  49.       (vla-startundomark doc)
  50.       (setq lyrs (vla-get-layers doc))
  51.       (setq blks (vla-get-blocks doc))
  52.       (setq cLyrNme (getvar 'clayer))
  53.       (foreach obj (mapcar 'vlax-ename->vla-object (_Conv_Pickset_To_EnameList ss))
  54.         (N_Modify obj)
  55.       )
  56.       (setq i 0)
  57.       (while (< i (length blkLst))
  58.         (if (= :vlax-false (vla-get-isxref (nth i blkLst)))
  59.           (vlax-for obj (nth i blkLst)
  60.             (N_Modify obj)
  61.           )
  62.         )
  63.         (setq i (1+ i))
  64.       )
  65.       (vla-endundomark doc)
  66.     )
  67.   )
  68.   (princ)
  69. )
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 08, 2016, 10:47:43 AM
a great code ,ROY
THANKS A LOT FOR  YOUR TIME ...
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 09, 2016, 08:24:30 AM
Code - Auto/Visual Lisp: [Select]
  1. ;Change all TrueColor to AutoCAD Color Index
  2. (defun c:all_to_aci ( / remove420 la e)
  3.   (defun remove420 (entity_list)
  4.     (entmod (vl-remove (assoc 420 entity_list) entity_list))
  5.     )
  6.   (while
  7.     (setq la (tblnext "layer" (not la)))
  8.     (remove420 (entget (tblobjname "layer" (cdr (assoc 2 la)))))
  9.     )
  10.   (while (setq e (if e (entnext e) (entnext)))
  11.     (remove420 (entget e))
  12.   )
  13.   (princ)
  14. )


i want this lisp to be applied to blocks subentities ... can you help me ,roy?

best regards
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: ribarm on February 09, 2016, 08:50:20 AM
http://www.lee-mac.com/colourconversion.html#truaci
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 09, 2016, 12:02:42 PM
iam not a lisp developer ... iam just a simple user of them .... can you pleas write this lisp to me ... i don't knew how to use lee mac function as a lisp and don't knew what's the command used to run this lisp
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: dgorsman on February 09, 2016, 01:57:11 PM
A gentle word of advice: coding forums in general aren't a "code house" where others create programs to suit your needs.  They are for assisting those who are trying to understand and write the code.  While you may get some generous posters to provide one or two samples to start with, unless you make an attempt to understand how the code operates you'll quickly find your questions left unanswered.
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 09, 2016, 02:10:33 PM
dgorsman,thanks for your gentle advice ...
but iam not a programmer iam an electrical engineer and i do my best to modify my lisps as possible ... but advanced lisps codes i try to understand them by comparison as i have no time to learn programming or coding ...
once someone modify this lisp others who need this lisp will find it and use it ... and others who wants to learn coding or programming will learn too ...
thanks
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on February 09, 2016, 02:21:45 PM
btw the developer of the original lisp modified it for me and now it works like a charm
the original thread : http://www.cadtutor.net/forum/showthread.php?88740-Change-especific-True-color-to-especific-ASC-color-by-LISP&p=653868#post653868 (http://www.cadtutor.net/forum/showthread.php?88740-Change-especific-True-color-to-especific-ASC-color-by-LISP&p=653868#post653868)
Code - Auto/Visual Lisp: [Select]
  1. (defun c:all_to_aci ( / remove420 la en)
  2.   (defun remove420 (entity_list)
  3.     (vl-catch-all-apply '(lambda nil (entmod (vl-remove (assoc 420 entity_list) entity_list))))
  4.     )
  5.   (while
  6.     (setq la (tblnext "layer" (not la)))
  7.     (remove420 (entget (tblobjname "layer" (cdr (assoc 2 la)))))
  8.     )
  10.     (if
  11.       (not (eq (vla-get-isxref block) :vlax-true))
  12.       (vlax-for en block
  13.         (remove420 (entget (vlax-vla-object->ename en)))
  14.         )
  15.       )
  16.     )
  17.   (princ)
  18. )
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on April 11, 2016, 05:44:03 PM
hey , roy_043
iam sorry but could you please modify this lisp so that it process the objects not more than one time (texts processed multiple times and the final result isn't the desired one.. thanks in advance

Code: [Select]
;--------code start--------;
(defun get-excel-data (/ ExcData xlApp xlBook xlCell xlRange xlSheet)
  (if (not (setq xlApp (vlax-get-object "Excel.Application")))
    (setq xlApp (vlax-create-object "Excel.Application"))
  )
  (if xlApp
    (progn
      (if
(not
  (vl-catch-all-error-p
    (vl-catch-all-apply
      (function (lambda ()
  (setq
    xlBook (vlax-get-property xlApp "ActiveWorkBook")
  )
)
      )
    )
  )
)
(progn
   (vlax-invoke-method xlBook "Activate")
   (setq xlSheet (vlax-get-property xlBook "ActiveSheet"))
     (if
  (vl-catch-all-error-p
    (vl-catch-all-apply
      (function (lambda ()
  (setq xlRange (vlax-get-property xlApp "Selection"))))))
  (setq xlRange (vlax-get-property xlSheet "UsedRange")))
   
(setq ExcData (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property xlRange "Value")
   )
)
   ) ;or Value2
   (setq ExcData
  (mapcar (function
    (lambda (x) (mapcar 'vlax-variant-value x))
  )
  ExcData
  )
   )

   (vlax-invoke-method xlApp "Quit")
)
      )
      (mapcar (function (lambda (x)
  (vl-catch-all-apply
    (function (lambda ()
(progn
  (vlax-release-object x)
  (setq x nil)
)
      )
    )
  )
)
      )
      (list xlCell xlRange xlSheet xlBook xlApp)
      )
    )
  )
  (gc)
  ExcData
)
; ------------------------------------------;

(defun newstring (old new str)
(while
(vl-string-search old str)
(setq str (vl-string-subst new old str))))

; ------------------------------------------;
(defun C:FRE ()

(vl-load-com)
(or adoc
    (setq adoc (vla-get-activedocument
(vlax-get-acad-object))))
(or acsp (setq acsp (if (= (getvar "CVPORT") 1)
(vla-get-paperspace
adoc)
(vla-get-modelspace
adoc)
)
)
    )
(vla-endundomark
  adoc)
(vla-startundomark
  adoc)
(setq repList (get-excel-data))
(vla-zoomall (vlax-get-acad-object))
(setq ss (ssget "_X" (list (cons 0 "*TEXT"))))
  (setq axss (vla-get-activeselectionset adoc))
  (vlax-for a axss
    (setq strRep (vlax-get-property a "TextString"))
    (while (vl-some (function (lambda(x)
     (vl-string-search x strRep)))
(mapcar 'car repList))

    (setq newStr
    (car
    (vl-remove-if 'not
    (mapcar (function (lambda(a b)(newstring a b strRep)))
   
    (mapcar 'car repList)(mapcar 'cadr repList)))))
    (setq strRep newStr))
      (vlax-put-property a "TextString" newStr)
       (vla-update a))
 

(vla-endundomark
  adoc)

  (princ)
)

(prompt "\n\t\t  * Type FRE to execute... *")
(princ)

credits for this lisp goes to fixo
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: ChrisCarlson on April 12, 2016, 07:58:51 AM
Your issue starts here

Code - Auto/Visual Lisp: [Select]
  1. (setq ss (ssget "_X" (list (cons 0 "*TEXT"))))


The "_X" signifies it will grab all entities and then filter to select only *TEXT entities (RTEXT, MTEXT, TEXT).
Title: Re: change lisp from applying to whole drawing to be applied to the selected objects
Post by: handasa on April 12, 2016, 02:35:38 PM
which replace text from opened excel window in background.

the point here that this lisp process the same text many time

say i have two columns as follow

green red
red yellow
yellow orange

so if i have three texts in the drawing "green , red, yellow" the result that the three texts will be "orange" which is undesired result

any suggestions ?