Instead of dialogue box I want user input at command promt only

Anonymous · ‎12-17-2018

Dear Helpers,

I need the below lisp modification with user input at command prompt instead of asking input in dialogue box. The basic function of this lisp code is to update the selected blocks colour to required user color. The updated lisp code shouldn't ask for color input in dialogue box, it should take input at command promt inly.

(defun c:CNB(/ adoc blocks color ins lays ss lst *error*)
;;; Color Area - - Changes in the color of selected items in the area
;;;http://www.cadtutor.net/forum/showthread.php?t=533&page=8
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun *error* (msg)(bg:layer-status-restore)(princ msg)(princ))
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
) ;_ end of setq
(if (and (setq color (acad_colordlg 256))
(setq ss (ssget))
(progn
(repeat (setq ins (sslength ss)) ;_ end setq
(setq lst (cons (ssname ss (setq ins (1- ins))) lst))
) ;_ end repeat
lst
) ;_ end of progn
) ;_ end of and
(progn
(vla-startundomark adoc)
(bg:layer-status-save)
(foreach ins lst
(setq ins (vlax-ename->vla-object ins))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Skip.")
(progn
(_pl:block-color blocks ins color lays)
(Change-Object-Color ins color)
)
) ;_ end of if
(Change-Object-Color ins color)
) ;_ end of if

) ;_ end of repeat
(vla-regen adoc acallviewports)
(bg:layer-status-restore)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz))
(vla-put-freeze lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
) ;_ end of and
(_pl:block-color blocks e color lays)
) ;_ end of if
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
) ;_ end of vlax-for
) ;_ end of defun
(defun Change-Object-Color (Obj Color / txtstr tmp txt)
;;;=============================================== =========================
;;;_color object start
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-TextColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj acByBlock));_Color
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp acByBlock) ;_Color
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq txtstr
((lambda (mtext / text str)
(setq Text "")
(while (/= Mtext "")
(cond
((wcmatch(strcase (setq Str (substr Mtext 1 3)))"{\\C") ;_ end of wcmatch
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext)))) ;_ end of setq
)
((wcmatch(strcase (setq Str (substr Mtext 1 2)))"\\C")
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext))))
)
((wcmatch(strcase (setq Str (substr Mtext 1 2))) "\\[{}]")
(setq Text (strcat Text (substr Mtext 1 2))
Mtext (substr Mtext 3)
) ;_ end of setq
)
((wcmatch (substr Mtext 1 1) "[{}]")
(setq Mtext (substr Mtext 2))
)
(t
(setq Text (strcat Text (substr Mtext 1 1))
Mtext (substr Mtext 2)
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of while
text
) ;_lambda
txtstr
)
)
(vlax-put-property Obj 'TextString (strcat "{\\C" (itoa color) ";" txtstr "}"))
);_progn
)

) ;_ end of progn
) ;_ end of if
;;;_color object end
;;;=============================================== =========================
) ;_ end of defun
(defun bg:layer-status-restore ()
(foreach item *BG_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *BG_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *BG_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *BG_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*BG_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun
(progn
(princ
"\ColorA - Changes in the color of selected items in the area"
) ;_ end of princ
(princ)
) ;_ end of progn

dbhunia · ‎12-17-2018

Try this......

(defun c:CNB(/ adoc blocks color ins lays ss lst *error*)
;;; Color Area - - Changes in the color of selected items in the area
;;;http://www.cadtutor.net/forum/showthread.php?t=533&page=8
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun *error* (msg)(bg:layer-status-restore)(princ msg)(princ))
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
) ;_ end of setq
;(if (and (setq color (acad_colordlg 256))
(if (and (setq color (getint "\nInput Color Code (Within 0-256): "))
(setq ss (ssget))
(progn
(repeat (setq ins (sslength ss)) ;_ end setq
(setq lst (cons (ssname ss (setq ins (1- ins))) lst))
) ;_ end repeat
lst
) ;_ end of progn
) ;_ end of and
(progn
(vla-startundomark adoc)
(bg:layer-status-save)
(foreach ins lst
(setq ins (vlax-ename->vla-object ins))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Skip.")
(progn
(_pl:block-color blocks ins color lays)
(Change-Object-Color ins color)
)
) ;_ end of if
(Change-Object-Color ins color)
) ;_ end of if

) ;_ end of repeat
(vla-regen adoc acallviewports)
(bg:layer-status-restore)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz))
(vla-put-freeze lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
) ;_ end of and
(_pl:block-color blocks e color lays)
) ;_ end of if
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
) ;_ end of vlax-for
) ;_ end of defun
(defun Change-Object-Color (Obj Color / txtstr tmp txt)
;;;=============================================== =========================
;;;_color object start
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-TextColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj acByBlock));_Color
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp acByBlock) ;_Color
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq txtstr
((lambda (mtext / text str)
(setq Text "")
(while (/= Mtext "")
(cond
((wcmatch(strcase (setq Str (substr Mtext 1 3)))"{\\C") ;_ end of wcmatch
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext)))) ;_ end of setq
)
((wcmatch(strcase (setq Str (substr Mtext 1 2)))"\\C")
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext))))
)
((wcmatch(strcase (setq Str (substr Mtext 1 2))) "\\[{}]")
(setq Text (strcat Text (substr Mtext 1 2))
Mtext (substr Mtext 3)
) ;_ end of setq
)
((wcmatch (substr Mtext 1 1) "[{}]")
(setq Mtext (substr Mtext 2))
)
(t
(setq Text (strcat Text (substr Mtext 1 1))
Mtext (substr Mtext 2)
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of while
text
) ;_lambda
txtstr
)
)
(vlax-put-property Obj 'TextString (strcat "{\\C" (itoa color) ";" txtstr "}"))
);_progn
)

) ;_ end of progn
) ;_ end of if
;;;_color object end
;;;=============================================== =========================
) ;_ end of defun
(defun bg:layer-status-restore ()
(foreach item *BG_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *BG_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *BG_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *BG_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*BG_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun
(progn
(princ
"\ColorA - Changes in the color of selected items in the area"
) ;_ end of princ
(princ)
) ;_ end of progn

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....

Anonymous · ‎12-18-2018

Dear Sir,

I have tried lisp command CNB in script as below

sdi 1
open "C:\Users\110187\Desktop\TEST\20181218-SCR TEST\TEST.dwg" SBN *RGR* CNB 8
sdi 0
close

Actually this script should open all the drawings in specified path and the block named as RGR should be converted in grey color (8 color). But when I am making script with the CNB command, again autocad asking user input with dialogue box. the CNB lisp command not working with scripting

dbhunia · ‎12-18-2018

@Anonymous wrote:

Dear Sir,

I have tried lisp command CNB in script as below
sdi 1
open "C:\Users\110187\Desktop\TEST\20181218-SCR TEST\TEST.dwg" SBN *RGR* CNB 8
sdi 0
close
Actually this script should open all the drawings in specified path and the block named as RGR should be converted in grey color (8 color). But when I am making script with the CNB command, again autocad asking user input with dialogue box. the CNB lisp command not working with scripting

the blue highlighted things are what for?

Did you appload the LISP before running it?

Through script CNB is working as expected for me......

I am using this script.......

open "C:\Users\DEBASHIS\Downloads\test (3).dwg"
(load "C:\\Users\\DEBASHIS\\Desktop\\1111111111111111 - Copy.lsp")
CNB
8
ALL

And the output is attached in attachment .... watch it.....

Debashis Bhunia
Co-Founder of Geometrifying Trigonometry(C)
________________________________________________
Walking is the First step of Running, Technique comes Next....

Community

Instead of dialogue box I want user input at command promt only

Instead of dialogue box I want user input at command promt only

Instead of dialogue box I want user input at command promt only