Lisp edit properties and change the name of Block

May 9, 2023

Hello everyone. I'm from Vietnam, I'd love to get some help.
I have collected a feBlock to layer 0 .lspw lisp codes and want to combine them all into one lisp that uses dialogs. My understanding of lisp is not good please help

Once again I hope everyone can help me with a complete lisp code so I can apply it to my work.
Thanks everyone.

Block_Edit-dialog Box.lsp ChangeBlockBasePointV1-5.lsp

renB.lsp

Edited May 9, 2023 by Jerry_VN

May 9, 2023

Can you give a bit more of a description of what you want to do - we can collate the LISPs into a single routine but knowing what you want to achieve will help.

So far:

Move block to layer 0

Rename block

Change the block base point

and rename block again

May 10, 2023

4 hours ago, Steven P said:

Bạn có thể mô tả thêm một chút về những gì bạn muốn làm không - chúng tôi có thể đối chiếu các LISP thành một quy trình duy nhất nhưng biết những gì bạn muốn đạt được sẽ giúp ích.

Cho đến nay:

Di chuyển khối đến lớp 0

Đổi tên khối

Thay đổi điểm cơ sở khối

và đổi tên khối một lần nữa

I want a lisp code to use dialog box.
Due to the use of the required conditions
Use the selected block to play, change the name of the block to change it to 1 block every time
Block settings. If using this option, select Block and select new data for Block.
If you tick the checkboxes to select all layers, in Block ve layer 0 and bylayer, all layers in Block will move to layer 0-Bylayer. If left unchecked, this will not be displayed.
I hope you can help me! Thank you very much

May 10, 2023

The dialog box is a lisp you made? Cause it's not working at all right now.

Ain't got the time right now to check it out, but i would think the following steps should be taken:

The renaming part shouldn't be that difficult. Upon entering the 'Edit_Block' command it should know if you allready selected a block or you start the command without selecting. create a dedicated button to select a block, not just go to some 'selection' option when you click the input field (or have some grayed out text stating something like 'click here to select a block')
Upon selecting a block the field should be occupied with the blocks name you have selected.

Enter the new name of the block.

Up to this point you should save these variables (old block name and the new name) globally. This would be hard to impossible to do without user input, so it could be done just before any new action is taken (like pressing OK or any of the other buttons)

When pressing any of the options that run those other lisp codes it should check in any of these variables is set and work from there. Save the new insertion point in memory (a variable).

When this seperate lisp has run it should once again check if the initial command has allready been running and continue from there (with all the previous fields filled).

In the end it should run all the commands in 1 run when pressed 'OK' with the previous set variables (old name, new name, new insertion point and if the objects within the block needs to be on layer 0 or not). When done, clear memory/stored variables.

It perhaps could be done a lot simpler, but that would by my approach.

I would advice to include some option to only change that selected objects block-name or all in the current drawing. i for one would like a working lisp like you are suggesting, but i ussually want to change 1 block of many. Simpy exploding and recreating or copying to a new drawing and back is a 'lot of work'.

May 10, 2023

43 minutes ago, OMEGA-ThundeR said:

The dialog box is a lisp you made? Cause it's not working at all right now.

Ain't got the time right now to check it out, but i would think the following steps should be taken:

The renaming part shouldn't be that difficult. Upon entering the 'Edit_Block' command it should know if you allready selected a block or you start the command without selecting. create a dedicated button to select a block, not just go to some 'selection' option when you click the input field (or have some grayed out text stating something like 'click here to select a block')
Upon selecting a block the field should be occupied with the blocks name you have selected.

Enter the new name of the block.

Up to this point you should save these variables (old block name and the new name) globally. This would be hard to impossible to do without user input, so it could be done just before any new action is taken (like pressing OK or any of the other buttons)

When pressing any of the options that run those other lisp codes it should check in any of these variables is set and work from there. Save the new insertion point in memory (a variable).

When this seperate lisp has run it should once again check if the initial command has allready been running and continue from there (with all the previous fields filled).

In the end it should run all the commands in 1 run when pressed 'OK' with the previous set variables (old name, new name, new insertion point and if the objects within the block needs to be on layer 0 or not). When done, clear memory/stored variables.

It perhaps could be done a lot simpler, but that would by my approach.

I would advice to include some option to only change that selected objects block-name or all in the current drawing. i for one would like a working lisp like you are suggesting, but i ussually want to change 1 block of many. Simpy exploding and recreating or copying to a new drawing and back is a 'lot of work'.

The dialog part is that I edited myself, but I can't get it to work because I can't do it.
I want to create a lisp dialog box similar to the attached image, with the command name: DRB, after entering the command, the user will select any Block and the dialog box opens with options:
If you want to change the Block name, enter a new name in the "Enter new name Block" field.
the "Current block name" item only shows the Block name without allowing changes.
Next will be the option "Pick change Block base point" if the user wants to change the set point of the Block, similarly if you want to change the inner layer of the Block to layer 0 without changing "linetyscale, linetype.." then select the option "Change layer inside block to layer 0"

May 11, 2023

Your answering some of your own questions if new block name is "" ie blank then use that in a IF.

Change the edit block to either 2 radio buttons or 2 Buttons or Toggles.

Last need to action_tile "accept" which is the OK button and get all 4 tile answers and then use a combination of cond and ifs. Your only getting 1,

(action_tile "Newname" "(done_dialog 2)")

Something like this, need some time to work it out.

(action_tile "accept" "(setq val1 (get_tile "newname" ....(setq val2 (get_tile "pickpoint"....(setq val3 "get_tile "layer0"...)(done_dialog)"

And you need a set_tile "oldname" so the block name is displayed.

May 11, 2023

45 minutes ago, BIGAL said:
Your answering some of your own questions if new block name is "" ie blank then use that in a IF.

Change the edit block to either 2 radio buttons or 2 Buttons or Toggles.

Last need to action_tile "accept" which is the OK button and get all 4 tile answers and then use a combination of cond and ifs. Your only getting 1,

(action_tile "Newname" "(done_dialog 2)")

Something like this, need some time to work it out.
(action_tile "accept" "(setq val1 (get_tile "newname" ....(setq val2 (get_tile "pickpoint"....(setq val3 "get_tile "layer0"...)(done_dialog)"
And you need a set_tile "oldname" so the block name is displayed.

Thank you for your interest
Can you help me to complete the lisp?
I'm sorry, but I can't do it

May 11, 2023

I had to slightly change Lee's routine so that it is passed the block name preselected. So added -blk to file name.

Not seriously tested let me know how you go.

(defun c:Block_edit ( / *error* dcf dch dcl des ent )
 
    (defun *error* ( msg )
        (if (< 0 dch) (unload_dialog dch))
        (if (= 'file (type des)) (close des))
        (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
	
	
(setq des (open (setq dcl (vl-filename-mktemp "" "" ".dcl")) "w"))
    
            (foreach str
               '(
                    "test : dialog"
                    "{"
                    " label = \"BLOCK EDIT\";"
		    " initial_focus = \"Newname\";"
		    "spacer;"
		    ": boxed_column"
		    "{"
		    " label = \"-- RENAME BLOCK --\";"
		    ": column"
		    "{"
		    "alignment = left;"
		    "fixed_width = true;" ": text {" "label = \"Current block name :\";" "}"
		    ": edit_box {" "key = \"Oldname\";" "allow_accept = true;" "edit_width = 60;" "fixed_width = true;" "}"
		    "alignment = left;"
		    "fixed_width = true;" ": text {" "label = \"Enter new block name :\";" "}"
		    ": edit_box {" "key = \"Newname\";" "allow_accept = true;" "edit_width = 60;" "fixed_width = true;" "}"
		    "}" "}"

		    ": boxed_column"
		    "{"
		    " label = \"-- EDIT BLOCK --\";"
		    ": row"
                    "{"
            ": radio_button {" "key = \"Pickpoint\";" " label = \"Pick change block base point\";" "allow_accept = true;" "}" "}"
		    ": row"
                    "{"		    
		    ": radio_button {" "key = \"Layer0\";" " label = \"Change layer inside a block to layer 0 by layer\";" "allow_accept = true;"  "}" "}"
                    "}"
		   ;"}" "}"
		    ": boxed_column"
		    "{"
		    " label = \"-- FINISH --\";"
		    ": row"
                    "{"
		    "fixed_width = true;" "alignment = centered;"
                    ": ok_cancel{" "width = 20;" "}"
		   "}" "}"
		   "}"
                )
                (write-line str des)
            )

(close des)

(setq ent (car (entsel "\nPick Block ")))
(setq oldname (cdr (assoc 2 (entget ent))))

(setq dcl_id (load_dialog dcl))
(if (not (new_dialog "test" dcl_id))
    (exit)
)

(set_tile "Oldname" oldname)		
(action_tile "accept" "(setq newname (get_tile \"Newname\")) (setq pickpoint (get_tile \"Pickpoint\")) (setq layer0 (get_tile \"Layer0\"))(done_dialog)")
(action_tile "cancel" "(setq cancel 1)(done_dialog)")

(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete dcl)
  
(setq *error* nil)

(if (= newname "")
  (princ "\nSkipping block rename ")
  (progn
    (setq blk (tblsearch "BLOCK" oldname))
    (command "rename" "Block" oldname newname)
  )
)

(if (= pickpoint "1")
(progn
(if (= newname nil)
(setq blkname oldname)
(setq blkname newname)
)
(load "ChangeBlockBasePointV1-5-blk")
(LM:changeblockbasepoint t ent)
)
)

(if (= layer0 "1")
(progn
(if (= newname nil)
(setq blkname oldname)
(setq blkname newname)
)
(load "change to zero") ; dont have this lisp
(c:xxx) ; now run itoa
)
)

(princ)

)
(c:Block_edit)

ChangeBlockBasePointV1-5-blk.lsp

Edited May 11, 2023 by BIGAL

May 11, 2023

6 hours ago, BIGAL said:
Tôi đã phải thay đổi một chút thói quen của Lee để nó được chuyển qua tên khối đã chọn trước. Vì vậy, đã thêm -blk vào tên tệp.

Không nghiêm túc kiểm tra cho tôi biết làm thế nào bạn đi.
 
	
	
    






  
Thank you very much for your help. But the code did not work because of OK and Cancel error.
Sorry if I asked too much, hope to get some help..

I want them to come together, and be able to work just fine.
I can't link them..

(defun c:RenB_VN (/ obj old new)
;; Rename Selected Block
;; Required Subroutines: AT:GeSel, AT:Getstring
;; Alan J. Thompson, 03.10.10 / 07.15.10
(if
(and
(AT:GetSel
entsel
"\nSelect block to rename: "
(lambda (x)
(if
(and (eq "INSERT" (cdr (assoc 0 (entget (car x)))))
(/= 4
(logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car x))))))) 4)
)
)
(setq obj (vlax-ename->vla-object (car x)))
)
)
)

(setq old (if (vlax-property-available-p obj 'effectivename)
(vla-get-effectivename obj)
(vla-get-name obj)
)
)
(not (vl-position
(setq new (AT:GetString "Specify new block name:" old))
(list old "" nil)
)
)
)
(cond
((tblsearch "BLOCK" new) (alert (strcat "\"" new "\" already exists!")))
((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!")))
((and (snvalid new) (not (tblsearch "block" new)))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-name
(list
(vla-item (vla-get-blocks
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
old
)
new
)
)
)
(alert (strcat "Block: " old " could not be renamed to: " new))
(alert (strcat "Block: " old " renamed to: " new))
)
)
)
)
(princ)
)

(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(while
(progn (setvar 'ERRNO 0)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)

(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
;; Getstring Dialog Box
;; #Title - Title of dialog box
;; #Default - Default string within edit box
;; Alan J. Thompson, 08.25.09
(setq #FileName (vl-filename-mktemp "" "" ".dcl")
#FileOpen (open #FileName "W")
)
(foreach x '(
"TempEditBox : dialog {"
   "key = \"Title\";"
" label = \"BLOCK EDIT\";"
       " initial_focus = \"Edit\";"
       "spacer;"
       ": boxed_column"
       "{"
       " label = \"-- RENAME BLOCK --\";"
       ": column"
       "{"
       "alignment = left;"
       "fixed_width = true;" ": text {" "label = \"Current block name :\";" "}"
       ": edit_box {" "key = \"Oldname\";" "allow_accept = true;" "edit_width = 60;" "fixed_width = true;" "}"
       "alignment = left;"
       "fixed_width = true;" ": text {" "label = \"Enter new block name :\";" "}"
       ": edit_box {" "key = \"Newname\";" "allow_accept = true;" "edit_width = 60;" "fixed_width = true;" "}"
       "}" "}"

       ": boxed_column"
       "{"
       " label = \"-- Change Block Base Point --\";"
       ": row"
"{"
       "fixed_width = true;" "alignment = centered;"
": Pick_button {" "width = 20;" "}"

       "}" "}"
       ": boxed_column"
       "{"
       " label = \"-- FINISH --\";"
       ": row"
"{"
       "fixed_width = true;" "alignment = centered;"
": ok_button {" "width = 20;" "}"
       ": cancel_button {" "width = 20;" "}"
       "}" "}"
       "}"
)
(write-line x #FileOpen)
)
(close #FileOpen)
(setq #DclID (load_dialog #FileName))
(new_dialog "TempEditBox" #DclID)
(set_tile "Title" #Title)
(set_tile "Newname" #Default)
(action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog #DclID)
(vl-file-delete #FileName)
#NewString
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Added conditions when picking " Pick ChangeBlockBasePoint " ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun LM:changeblockbasepoint ( flg / *error* bln cmd ent lck mat nbp vec )

(defun *error* ( msg )
(foreach lay lck (vla-put-lock lay :vlax-true))
(if (= 'int (type cmd)) (setvar 'cmdecho cmd))
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)

(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type ent))
(if (/= "INSERT" (cdr (assoc 0 (entget ent))))
(princ "\nSelected object is not a block.")
)
)
)
)
)
(if (and (= 'ename (type ent)) (setq nbp (getpoint "\nSpecify New Base Point: ")))
(progn
(setq mat (car (revrefgeom ent))
vec (mxv mat (mapcar '- (trans nbp 1 0) (trans (cdr (assoc 10 (entget ent))) ent 0)))
bln (LM:blockname (vlax-ename->vla-object ent))
)
(LM:startundo (LM:acdoc))
(vlax-for lay (vla-get-layers (LM:acdoc))
(if (= :vlax-true (vla-get-lock lay))
(progn
(vla-put-lock lay :vlax-false)
(setq lck (cons lay lck))
)
)
)
(vlax-for obj (vla-item (vla-get-blocks (LM:acdoc)) bln)
(vlax-invoke obj 'move vec '(0.0 0.0 0.0))
)
(if flg
(vlax-for blk (vla-get-blocks (LM:acdoc))
(if (= :vlax-false (vla-get-isxref blk))
(vlax-for obj blk
(if
(and
(= "AcDbBlockReference" (vla-get-objectname obj))
(= bln (LM:blockname obj))
(vlax-write-enabled-p obj)
)
(vlax-invoke obj 'move '(0.0 0.0 0.0) (mxv (car (refgeom (vlax-vla-object->ename obj))) vec))
)
)
)
)
)
(if (= 1 (cdr (assoc 66 (entget ent))))
(progn
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(vl-cmdf "_.attsync" "_N" bln)
(setvar 'cmdecho cmd)
)
)
(foreach lay lck (vla-put-lock lay :vlax-true))
(vla-regen (LM:acdoc) acallviewports)
(LM:endundo (LM:acdoc))
)
)
(princ)
)

;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)

(defun refgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 ocs t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list
(list (cdr (assoc 41 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
)
)
)

;; RevRefGeom (gile)
;; The inverse of RefGeom

(defun revrefgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(list
(list (/ 1.0 (cdr (assoc 41 enx))) 0.0 0.0)
(list 0.0 (/ 1.0 (cdr (assoc 42 enx))) 0.0)
(list 0.0 0.0 (/ 1.0 (cdr (assoc 43 enx))))
)
(mxm
(list
(list (cos ang) (sin ang) 0.0)
(list (- (sin ang)) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar '(lambda ( v ) (trans v ocs 0 t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
)
)
)
(mapcar '- (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
(mxv mat (trans (cdr (assoc 10 enx)) ocs 0))
)
)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
(apply 'mapcar (cons 'list m))
)

;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference

(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
(strcat
"\n:: ChangeBlockBasePoint.lsp | Version 1.5 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Available Commands:"
"\n:: \"CBP\" - Retain Insertion Point Position"
"\n:: \"CBPR\" - Retain Block Reference Position"
)
)
(princ)

;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Added conditions when picking " Change Layer inside Block to Layer O ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:blkto0 ( / idx lst sel )
(if (setq sel (ssget '((0 . "INSERT"))))
(repeat (setq idx (sslength sel))
(block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx)))))))
)
)
(command "_.regen")
(princ)
)
(defun block->0 ( blk / ent enx )
(cond
( (member blk lst))
( (setq ent (tblobjname "block" blk))
(while (setq ent (entnext ent))
(entmod (subst-append 8 "0" (subst-append 62 256 (setq enx (entget ent)))))
(if (= "INSERT" (cdr (assoc 0 enx)))
(block->0 (cdr (assoc 2 enx)))
)
)
(setq lst (cons blk lst))
)
)
)
(defun subst-append ( key val lst / itm )
(if (setq itm (assoc key lst))
(subst (cons key val) itm lst)
(append lst (list (cons key val)))
)
)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

ChangeBlockBasePointV1-5-blk.lsp 11,87 kB · 0 lượt tải xuống

Sign In

Lisp edit properties and change the name of Block

Recommended Posts

Jerry_VN

Steven P

Jerry_VN

OMEGA-ThundeR

Jerry_VN

BIGAL

Jerry_VN

BIGAL

Jerry_VN

Join the conversation

Tutorials

Forums

Activity