Author Topic: Help : Replace Points With Block  (Read 1732 times)

0 Members and 1 Guest are viewing this topic.

pedroantonio

  • Guest
Help : Replace Points With Block
« on: April 07, 2017, 06:27:37 AM »
Hi. i am using this lisp code to change block to points and points to blocks

I have problem with the layes

1) when i change the point to block --> the block goes to the layer of the point. My blocks have their own layes .I want the block to go to his own layer
2)when i change theblock to point the point does to block layer. I want the point to go to a new layer with name NEW POINTS

Code: [Select]
(COMMAND "_layer" "_m" "NEW POINTS" "_c" "10" "" "") ; I add this line to the code but is not working

Can any one help ?

Code - Auto/Visual Lisp: [Select]
  1. ;;
  2. ;;     Replace Points With Block
  3. ;;
  4.  
  5. (defun c:p2b (/ *error* _blocks lst block ss space)
  6.  
  7.  
  8.   (defun *error* (msg)
  9.     (and *AcadDoc* (vla-endundomark *AcadDoc*))
  10.     (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
  11.       (princ (strcat "\nError: " msg))
  12.     )
  13.   )
  14.  
  15.   (defun _blocks (doc / l)
  16.     (vlax-for x (vla-get-blocks doc)
  17.       (if (not (wcmatch (vla-get-name x) "*|*,`**"))
  18.         (setq l (cons (vla-get-name x) l))
  19.       )
  20.     )
  21.     (vl-sort l '<)
  22.   )
  23.  
  24.     (cond (*AcadDoc*)
  25.           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  26.     )
  27.   )
  28.  
  29.   (cond ((not (setq lst (_blocks *AcadDoc*))) (alert "Zero blocks in active drawing!"))
  30.         ((and (setq block (car (AT:ListSelect "Select block to insert:" "" 10 10 "false" lst)))
  31.               (princ "\nSelect POINT objects to replace: ")
  32.               (ssget "_:L" '((0 . "POINT")))
  33.          )
  34.  
  35.          (setq space (vlax-get-property
  36.                        *AcadDoc*
  37.                        (if (eq (getvar 'CVPORT) 1)
  38.                          'PaperSpace
  39.                          'ModelSpace
  40.                        )
  41.                      )
  42.          )
  43. ;(setq scl (getvar "useri1"))
  44. ; (setq scl1 (* scl 0.0025))
  45.  (setq scl1 1)
  46.          (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
  47.            (if (vla-insertblock space (vla-get-coordinates x) block scl1 scl1 scl1. 0.)
  48.              (vla-delete x)
  49.            )
  50.          )
  51.  
  52.          (vla-delete ss)
  53.         )
  54.   )
  55.   (*error* nil)
  56. (setvar 'pdmode 0)
  57.   (princ)
  58. )
  59.  
  60.  
  61.  
  62.  
  63. (defun AT:ListSelect (title label height width multi lst / fn fo d item f)
  64.   ;; List Select Dialog (Temp DCL list box selection, based on provided list)
  65.   ;; title - list box title
  66.   ;; label - label for list box
  67.   ;; height - height of box
  68.   ;; width - width of box
  69.   ;; multi - selection method ["true": multiple, "false": single]
  70.   ;; lst - list of strings to place in list box
  71.   ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
  72.   (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
  73.   (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
  74.                    (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
  75.                    (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
  76.                    (strcat "width = " (vl-princ-to-string width) ";")
  77.                    (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
  78.              )
  79.     (write-line x fo)
  80.   )
  81.   (close fo)
  82.   (new_dialog "list_select" (setq d (load_dialog fn)))
  83.   (start_list "lst")
  84.   (setq item (set_tile "lst" "0"))
  85.   (action_tile "lst" "(setq item $value)")
  86.   (if (= f 1)
  87.     ((lambda (s / i s l)
  88.        (while (setq i (vl-string-search " " s))
  89.          (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
  90.          (setq s (substr s (+ 2 i)))
  91.        )
  92.        (reverse (cons (nth (atoi s) lst) l))
  93.      )
  94.       item
  95.     )
  96.   )
  97. )
  98.  
  99. ;
  100. ;  Block to point
  101. ;
  102. (defun c:b2p (/ ss i e d)
  103.   (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
  104.     (repeat (setq i (sslength ss))
  105.       (if (entmakex (list '(0 . "POINT")
  106.                           (assoc 8 (setq d (entget (setq e (ssname ss (setq i (1- i)))))))
  107.                           (cons 10 (trans (cdr (assoc 10 d)) e 0))
  108.                           (assoc 210 d)
  109.                     )
  110.           )
  111.         (entdel e)
  112.       )
  113.     )
  114.   )
  115.   (princ)
  116. )
  117.  

ChrisCarlson

  • Guest
Re: Help : Replace Points With Block
« Reply #1 on: April 07, 2017, 08:31:23 AM »
These are two incredibly easy issues to resolve. Please research and study.
Code - Auto/Visual Lisp: [Select]

pedroantonio

  • Guest
Re: Help : Replace Points With Block
« Reply #2 on: April 07, 2017, 10:50:49 AM »
Hi   Master_Shake . Is any way to put put the inset block to his layer ?

I found this ronjonp code

Code - Auto/Visual Lisp: [Select]
  1.   (vlax-for b2 b
  2.     (if   (and (vlax-property-available-p b2 'name) (wcmatch (strcase (vla-get-name b2)) "BLK1"))
  3.       (vla-put-layer b2 "LAYER")
  4.     )
  5.   )
  6. )
  7.  

But i have to write it for every block i have. is any faster way?



ChrisCarlson

  • Guest
Re: Help : Replace Points With Block
« Reply #3 on: April 07, 2017, 11:48:34 AM »
You could do something like

Code - Auto/Visual Lisp: [Select]
  1. (vlax-put (vlax-ename->vla-object (ssname (ssget "_L") 0)) 'Layer
  2.         (vla-get-effectivename(vlax-ename->vla-object (ssname (ssget "_L") 0)))
  3. )

I can't test it at the moment but you could pull the name of the block to set the layer

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Help : Replace Points With Block
« Reply #4 on: April 08, 2017, 02:02:59 AM »
Hi,

EDIT: Sorry, broken link...
« Last Edit: April 08, 2017, 03:37:31 AM by Tharwat »

pedroantonio

  • Guest
Re: Help : Replace Points With Block
« Reply #5 on: April 08, 2017, 02:58:50 AM »
Hi  Tharwat. The file is deleted

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: Help : Replace Points With Block
« Reply #6 on: April 08, 2017, 03:38:27 AM »
Hi  Tharwat. The file is deleted

Very sorry, it seems that I have deleted the program and forgot about that and I should delete the related html page as well.