Javascript Disabled Detected

You currently have javascript disabled. Several functions may not work. Please re-enable javascript to access full functionality.

1

Block Replace Tool

Started by Johandre, Mar 05 2020 01:38 PM

block replace

You cannot reply to this topic
Go to first unread post

6 replies to this topic

#1 Johandre

Member

Members
13 posts

Posted 05 March 2020 - 01:38 PM

I think it would be handy to have a replace-block feature where it's possible to change out one block for another.

I found this LISP code, but get "error: invalid SSGET mode string" when I try it:

(defun c:QW4 (/ ss nbl)
  (prompt "\nSelect block: ")
  (if (setq ss (ssget "_:S:E" '((0 . "INSERT"))))
    (progn
	  (setq ss (entget (setq ss (ssname ss 0))))
	  (redraw (cdr (assoc 330 ss)) 3)
	  (prompt
"\nSelect blocks to be replaced: "
	  )
	  (while (setq nbl (ssget "_:S:E" '((0 . "INSERT"))))
(setq nbl (entget (setq nbl (ssname nbl 0))))
(entmod (subst (assoc 2 nbl)
		 (assoc 2 ss)
		 ss
  )
)
(redraw entBlock 4)
	  )
    )
  )
  (princ)
)
(prompt "Type >> Qw4 <<")

Something like AutoCAD's BLOCKREPLACE may be a good start, but it replaces all blocks, where I would like to select which blocks to replace.

If anybody has a working script, I'd really appreciate it, and if there are any plans to include this in nanoCAD officially, you have my vote!

Back to top

#2 Johandre

Member

Members
13 posts

Posted 05 March 2020 - 01:47 PM

I found this version that works. Does anybody know of a script that gives me a dialogue box instead of having to type the block names?

(defun c:Qw4 (/ Jr_replaceall answr ent idx nbl obj ss)
  (vl-load-com)
  (if (not Jr_replaceall)
    (setq Jr_replaceall "Single")
    )
  (Command "-.Undo" "_Be")
  (if (and (setq ss (ssget ":S" '((0 . "INSERT"))))
    (progn
	  (initget "S A")
	  (if (setq answr (getkword "\nReplace only this block or replace All [Single / All]:"))
	    (setq Jr_replaceall answr)
	    (setq answr Jr_replaceall)
	    )
	  )
    (setq nbl (getstring "\nBlock name to replace with: "))
    (tblobjname "BLOCK" nbl)
    )
    (progn
	  (if (eq Jr_replaceall "A")
(setq ss (ssget "x" (list '(0 . "INSERT") (assoc 2 (entget (ssname ss 0))))))
)
	  (setq idx -1)
	  (while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj nbl)
(vla-update obj)
)
	  )
    )
  (command "_.Undo" "_End")
  (princ (strcat "\nReplaced " (itoa idx) " Blocks"))
  (princ)
  )

Back to top

#3 pguimber

Advanced Member

Members
387 posts

LocationFrance - Maine et Loire

Posted 05 March 2020 - 08:55 PM

maybe it's time to get into LISP? ...

https://www.linkedin...rteau-b2143a49/

https://www.youtube....bgNJOH_Iqwq8K_g

Back to top

#4 Johandre

Member

Members
13 posts

Posted 06 March 2020 - 11:48 AM

One step ahead of you!

Once I get the hang of it more, I'll try DCL files with my LSP ones to see if that works.

I'm not quite there yet, but a dialogue box is less important than the fact there is a functioning tool available already.

Back to top

#5 pguimber

Advanced Member

Members
387 posts

LocationFrance - Maine et Loire

Posted 06 March 2020 - 01:06 PM

Johandre, on 06 March 2020 - 11:48 AM, said:

One step ahead of you!

On this subject, anyway I suck! :blink:

hardly good at copying other people's code ! :ph34r:

For example to list the coordinates of the points I use ptexport.lsp. I can change decimals but that's it. :rolleyes:

I can do scripts, but it's really not my first skill. :huh:

Spoiler

; ----------------------------------------------------------------------
;			 (Export LWPOLYLINE Vertices & Points to File)
;			Copyright © 2000 DotSoft, All Rights Reserved
;				   Website: [url="http://www.dotsoft.com"]http://www.dotsoft.com[/url]
; ----------------------------------------------------------------------
; DISCLAIMER:  DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose.  All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------

(defun c:ptexport ()
  (setq sset (ssget '((-4 . "<OR")(0 . "POINT")
					  (0 . "LWPOLYLINE")(-4 . "OR>"))))
  (if sset
	(progn
	  (setq itm 0 num (sslength sset))
	  (setq fn (getfiled "Point Export File" "" "txt" 1))
	  (if (/= fn nil)
		(progn
		  (setq fh (open fn "w"))
		  (while (< itm num)
			(setq hnd (ssname sset itm))
			(setq ent (entget hnd))
			(setq obj (cdr (assoc 0 ent)))
			(cond
			  ((= obj "POINT")
				(setq pnt (cdr (assoc 10 ent)))
				(princ (strcat (rtos (car pnt) 2 3) ","
							   (rtos (cadr pnt) 2 3) ","
							   (rtos (caddr pnt) 2 3)) fh)
				(princ "\n" fh)
			  )
			  ((= obj "LWPOLYLINE")
				(if (= (cdr (assoc 38 ent)) nil)
				  (setq elv 0.0)
				  (setq elv (cdr (assoc 38 ent)))
				)
				(foreach rec ent
				  (if (= (car rec) 10)
					(progn
					  (setq pnt (cdr rec))
					  (princ (strcat (rtos (car pnt) 2 3) ","
									 (rtos (cadr pnt) 2 3) ","
									 (rtos elv 2 8)) fh)
					  (princ "\n" fh)
					)
				  )
				)
			  )
			  (t nil)
			)
			(setq itm (1+ itm))
		  )
		  (close fh)
		)
	  )
	)
  )
  (princ)
)

(princ "\nPoint Export loaded, type PTEXPORT to run.")
(princ)

Johandre, on 06 March 2020 - 11:48 AM, said:

is less important than the fact there is a functioning tool available already

So much the better !

https://www.linkedin...rteau-b2143a49/

https://www.youtube....bgNJOH_Iqwq8K_g

Back to top

#6 Kreator

Advanced Member

Members
144 posts

LocationKrasnodar, Russia

Posted 06 March 2020 - 02:27 PM

BTW, you can use SPOILER and SQL BBCodes (LSP not available, CODE doesn't fit) formatting to make code more readable and compact

Spoiler

; ----------------------------------------------------------------------
; (Export LWPOLYLINE Vertices & Points to File)
; Copyright © 2000 DotSoft, All Rights Reserved
; Website: http://www.dotsoft.com
; ----------------------------------------------------------------------
; DISCLAIMER: DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose. All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
(defun c:ptexport ()
(setq sset (ssget '((-4 . "<OR")(0 . "POINT")
(0 . "LWPOLYLINE")(-4 . "OR>"))))
(if sset
(progn
(setq itm 0 num (sslength sset))
(setq fn (getfiled "Point Export File" "" "txt" 1))
(if (/= fn nil)
(progn
(setq fh (open fn "w"))
(while (< itm num)
(setq hnd (ssname sset itm))
(setq ent (entget hnd))
(setq obj (cdr (assoc 0 ent)))
(cond
((= obj "POINT")
(setq pnt (cdr (assoc 10 ent)))
(princ (strcat (rtos (car pnt) 2 3) ","
(rtos (cadr pnt) 2 3) ","
(rtos (caddr pnt) 2 3)) fh)
(princ "\n" fh)
)
((= obj "LWPOLYLINE")
(if (= (cdr (assoc 38 ent)) nil)
(setq elv 0.0)
(setq elv (cdr (assoc 38 ent)))
)
(foreach rec ent
(if (= (car rec) 10)
(progn
(setq pnt (cdr rec))
(princ (strcat (rtos (car pnt) 2 3) ","
(rtos (cadr pnt) 2 3) ","
(rtos elv 2 8)) fh)
(princ "\n" fh)
)
)
)
)
(t nil)
)
(setq itm (1+ itm))
)
(close fh)
)
)
)
)
(princ)
)
(princ "\nPoint Export loaded, type PTEXPORT to run.")
(princ)

Back to top

#7 pguimber

Advanced Member

Members
387 posts

LocationFrance - Maine et Loire

Posted 06 March 2020 - 02:54 PM

Ok, thank's...
Indeed it is more sympathetic!
It's clean and easy to read. Thank you

Spoiler

; ----------------------------------------------------------------------
; (Export LWPOLYLINE Vertices & Points to File)
; Copyright © 2000 DotSoft, All Rights Reserved
; Website: [url="http://www.dotsoft.com"]http://www.dotsoft.com[/url]
; ----------------------------------------------------------------------
; DISCLAIMER: DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose. All materials are
; to be considered ‘as-is’, and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
(defun c:ptexport ()
(setq sset (ssget '((-4 . "<OR")(0 . "POINT")
(0 . "LWPOLYLINE")(-4 . "OR>"))))
(if sset
(progn
(setq itm 0 num (sslength sset))
(setq fn (getfiled "Point Export File" "" "txt" 1))
(if (/= fn nil)
(progn
(setq fh (open fn "w"))
(while (< itm num)
(setq hnd (ssname sset itm))
(setq ent (entget hnd))
(setq obj (cdr (assoc 0 ent)))
(cond
((= obj "POINT")
(setq pnt (cdr (assoc 10 ent)))
(princ (strcat (rtos (car pnt) 2 3) ","
(rtos (cadr pnt) 2 3) ","
(rtos (caddr pnt) 2 3)) fh)
(princ "\n" fh)
)
((= obj "LWPOLYLINE")
(if (= (cdr (assoc 38 ent)) nil)
(setq elv 0.0)
(setq elv (cdr (assoc 38 ent)))
)
(foreach rec ent
(if (= (car rec) 10)
(progn
(setq pnt (cdr rec))
(princ (strcat (rtos (car pnt) 2 3) ","
(rtos (cadr pnt) 2 3) ","
(rtos elv 2 8)) fh)
(princ "\n" fh)
)
)
)
)
(t nil)
)
(setq itm (1+ itm))
)
(close fh)
)
)
)
)
(princ)
)
(princ "\nPoint Export loaded, type PTEXPORT to run.")
(princ)

https://www.linkedin...rteau-b2143a49/

https://www.youtube....bgNJOH_Iqwq8K_g

Back to top

Back to Wishlist · Next Unread Topic →

1 user(s) are reading this topic

0 members, 1 guests, 0 anonymous users