DCL Window

jerzy.bajor · ‎01-02-2023

Hi

With an active DCL window, how can I see the result of a selection in that window on the screen?

Jerzy

; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun c:qqww ( / path FileDCL Cen dcl_id figA  figB)
  (setq path (strcat (getvar "tempprefix") "JB-Sru.dcl")
	FileDCL (open path "w"))
  (write-line "Some : dialog {label = \"Something\";" FileDCL)
  (write-line ": radio_column {" FileDCL)
  (write-line ": radio_button {key = \"figA\"; label = \"figure A\";}" FileDCL)
  (write-line ": radio_button {key = \"figB\"; label = \"figure B\";}}" FileDCL)
  (write-line "ok_only;}"  FileDCL)
  (close FileDCL)
  (setq Cen (getvar "VIEWCTR")
	dcl_id (load_dialog path))
  (new_dialog "Some" dcl_id)
  (action_tile "figA" "(***figA) (if figB (vla-erase figB))")
  (action_tile "figB" "(***figB) (if figA (vla-erase figA))")
  (start_dialog)
  (unload_dialog dcl_id)  
  (acet-file-remove path)  
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***figA ()
  ;(entmakex (list (cons 0 "CIRCLE") (append (list 10) (trans Cen 1 0)) (cons 40 2)))
  (vla-addCircle (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point (trans Cen 1 0)) 2.0)
  (setq figA (vlax-ename->vla-object (entlast)))
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***figB ( / p1 p2 p3 p4)
  (setq p1 (polar Cen 0 1)
	p1 (polar p1 (* 0.5 pi) 1)
	p2 (polar p1 pi 2)
	p4 (polar p1 (* 1.5 pi) 2)
	p3 (polar p2 (* 1.5 pi) 2))
  ;(***polyA (list p1 p2 p3 p4))
  (***polyB (list (trans p1 1 0) (trans p2 1 0) (trans p3 1 0) (trans p4 1 0)))
  (setq figB (vlax-ename->vla-object (entlast)))  
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***polyA (!LstP)
  (entmakex
    (append
      (list
	'(000 . "LWPOLYLINE")
	'(100 . "AcDbEntity")
	'(100 . "AcDbPolyline")
	(cons 90 (fix (length (cdr !LstP))))
	'(070 . 1)
	(cons 38 (caddr (trans '(0.0 0.0) 1 0)))
	)
      (mapcar
	(function
	  (lambda (X)
	    (cons 10 (trans X 1 (trans '(0.0 0.0 1.0) 1 0 t)))))
	!LstP)
      (list (cons 210 (trans '(0.0 0.0 1.0) 1 0 t)))
      )
    )
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***polyB (lst / plist array)  
  (setq plist (apply 'append lst)
	array (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (length plist))) plist))  
  (vla-AddPolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) array)
  (vla-put-Closed (vlax-ename->vla-object (entlast)) 1)
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===

john.uhden · ‎01-02-2023

@jerzy.bajor

Sorry, but there are no image tiles that can show what's in the display.

My recommendation is to (sssetfirst nil ss), where ss is the selection set. Try it. It will put cold grips on all the entities selected. (sssetfirst) will turn off the grips.

Of course you'll probably have to douse the dialog and bring it back up if necessary to continue your program.

John F. Uhden

Moshe-A · ‎01-02-2023

@jerzy.bajor hi,

to achieve this you have to temporary hide the dialog using (done_dialog) function. i made the needed correction to your code.

here is some comments:

some variables (cen, figA, figB) are declared as local but use as global.

radio_button should be inside radio_column or radio_row tiles. they are design to enable\disable switches and not run a procedure to draw graphics. use button tiles instead.

enjoy

Moshe

(defun c:qqww ( / path FileDCL ;|Cen|; dcl_id ;| figA  figB |;)
  (setq path (strcat (getvar "tempprefix") "JB-Sru.dcl")
	FileDCL (open path "w"))
  (write-line "Some : dialog {label = \"Something\";" FileDCL)
  (write-line ": radio_column {" FileDCL)
  (write-line ": radio_button {key = \"figA\"; label = \"figure A\";}" FileDCL)
  (write-line ": radio_button {key = \"figB\"; label = \"figure B\";}}" FileDCL)
  (write-line "ok_only;}"  FileDCL)
  (close FileDCL)
  (setq Cen (getvar "VIEWCTR")	dcl_id (load_dialog path))

  (setq what_next 2)
  (while (> what_next 1)
    (if (not (new_dialog "Some" dcl_id "" '(-1 -1))); open dialog at center
     (exit)
    )
    
   (action_tile "figA" "(***figA)")
   (action_tile "figB" "(***figB)")
    
   ; (action_tile "figA" "(***figA) (if figB (vla-erase figB))")
   ; (action_tile "figB" "(***figB) (if figA (vla-erase figA))")
    
   (setq what_next (start_dialog))

   (cond
    ((= what_next 0) ; Cancel button picked
     nil
    ); case
    ((= what_next 1) ; OK button picked
     nil
    ); case
    ((= what_next 2) ; other button picked
     (getstring "\nPress any ket to continue...")
    ); case
   ); cond
  ); while
  
   (unload_dialog dcl_id)  
   (acet-file-remove path)  ; this call is redundant cause each qqww the
                            ; dcl is opened for write thus override the file 
  ); c:qqww

; === === === === === === === === === === === === === === === === === === === === === === === ===
; call back
(defun ***figA (/ rcode)
  ;(entmakex (list (cons 0 "CIRCLE") (append (list 10) (trans Cen 1 0)) (cons 40 2)))

  (setq rcode (done_dialog 2))  ; temporary close dialog
  (if figA (vla-delete figA))
  
  (vla-addCircle (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point (trans Cen 1 0)) 2.0)

   (setq figA (fetch_last_object))
   rcode
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===
; call back
(defun ***figB (/ rcode p1 p2 p3 p4)
  (setq rcode (done_dialog 2))
  (if figB (vla-delete figB))
  
  (setq p1 (polar Cen 0 1)
	p1 (polar p1 (* 0.5 pi) 1)
	p2 (polar p1 pi 2)
	p4 (polar p1 (* 1.5 pi) 2)
	p3 (polar p2 (* 1.5 pi) 2))
  ;(***polyA (list p1 p2 p3 p4))
  (***polyB (list (trans p1 1 0) (trans p2 1 0) (trans p3 1 0) (trans p4 1 0)))

   (setq figB (fetch_last_object))
   rcode
  ); ***figB

; === === === === === === === === === === === === === === === === === === === === === === === ===

 (defun fetch_last_object (/ obj)
  (if (not
	(vl-catch-all-error-p
	    (setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list (entlast))))
	)
      )
    obj
  )
 ); featch_last_object

; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***polyA (!LstP)
  (entmakex
    (append
      (list
	'(000 . "LWPOLYLINE")
	'(100 . "AcDbEntity")
	'(100 . "AcDbPolyline")
	(cons 90 (fix (length (cdr !LstP))))
	'(070 . 1)
	(cons 38 (caddr (trans '(0.0 0.0) 1 0)))
	)
      (mapcar
	(function
	  (lambda (X)
	    (cons 10 (trans X 1 (trans '(0.0 0.0 1.0) 1 0 t)))))
	!LstP)
      (list (cons 210 (trans '(0.0 0.0 1.0) 1 0 t)))
      )
    )
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***polyB (lst / plist array)  
  (setq plist (apply 'append lst)
	array (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (length plist))) plist))  
  (vla-AddPolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) array)
  (vla-put-Closed (vlax-ename->vla-object (entlast)) 1)
  )
; === === === === === === === === === === === === === === === === === === === === === === === ===

paullimapa · ‎01-02-2023

building upon @Moshe-A excellent solution, I've added the following:

localize functions & symbols
in addition to CIRCLE & SQUARE draw LINE option
zoom's in to object drawn
highlights and Shades (if there's an AREA) object drawn

;; qqww function brings up a dialog box for user to select different draw object options,
;; the dialog is temporarily dismissed to zoom into location where object is drawn
;; highlited and shaded if there's an area property
;; after receiving input from user dialog reappears for additional user selection
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/dcl-window/m-p/11652618#M441395
(defun c:qqww 
 ( / ***figA ***figB ***figC ***polyA ***polyB 
     Cen cmdecho dcl_id fetch_last_object figA figB figC FileDCL
     hilight menuecho path what_next zoomObject
 ) ; localize functions and symbols
  ; === === === === === === === === === === === === === === === === === === === === === === === ===
  (vl-load-com)
; call back
 (defun ***figA (/ rcode)
  ;(entmakex (list (cons 0 "CIRCLE") (append (list 10) (trans Cen 1 0)) (cons 40 2)))

  (setq rcode (done_dialog 2))  ; temporary close dialog
  (if figA (vla-delete figA))
  
  (vla-addCircle (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point (trans Cen 1 0)) 2.0)

  (setq figA (fetch_last_object))
   rcode
 ); ***figA
; === === === === === === === === === === === === === === === === === === === === === === === ===
; call back
 (defun ***figB (/ rcode p1 p2 p3 p4)
  (setq rcode (done_dialog 2))
  (if figB (vla-delete figB))
  
  (setq p1 (polar Cen 0 1)
	p1 (polar p1 (* 0.5 pi) 1)
	p2 (polar p1 pi 2)
	p4 (polar p1 (* 1.5 pi) 2)
	p3 (polar p2 (* 1.5 pi) 2))
  ;(***polyA (list p1 p2 p3 p4))
  (***polyB (list (trans p1 1 0) (trans p2 1 0) (trans p3 1 0) (trans p4 1 0)))

   (setq figB (fetch_last_object))
   rcode
 ); ***figB
; call back
 (defun ***figC (/ rcode p1 p2 p3)
  
  (setq rcode (done_dialog 2))  ; temporary close dialog
  (if figC (vla-delete figC))
  (setq p1 (polar Cen 0 1)
        p1 (polar p1 (* 0.5 pi) 1)
        p2 (polar p1 pi 2)
        p3 (polar p2 (* 1.5 pi) 2))
  (vla-addline (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point (trans p1 1 0))( vlax-3d-point (trans p3 1 0)))

  (setq figC (fetch_last_object))
   rcode
 ); ***figC
; === === === === === === === === === === === === === === === === === === === === === === === ===
; zoomObject function zooms in to given object location
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/zoom-object-problem/td-p/5031146
 (defun zoomObject (ob / minPt maxPt)
  (vla-GetBoundingBox ob 'minPt 'maxpt)
  (vla-ZoomWindow (vlax-get-acad-object) minPt maxpt)
 ); zoomObject
; === === === === === === === === === === === === === === === === === === === === === === === ===
; hilight function uses flg argument to highligt or unhighlight last object drawn
 (defun hilight (flg / obj)
  (if (not
       (vl-catch-all-error-p
        (setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list (entlast))))
       )
      )
    (if flg 
     (progn  
      (vla-highlight obj :vlax-true) 
      (if(not(vl-catch-all-error-p (vl-catch-all-apply 'getpropertyvalue (list (entlast) "Area"))))
       (progn
        (princ"\nPress Enter to continue...")
        (command"_.Area""_A""_O" (entlast)"") ; add shade if area prop
        (while (= 1 (logand 1 (getvar 'CMDACTIVE))) (command pause)) ; while there's an active command pause
       )
       (getstring "\nPress Enter to continue...")
      )
     )
     (vla-highlight obj :vlax-false)
    )
  )
 ) ; hilight
; === === === === === === === === === === === === === === === === === === === === === === === ===
 (defun fetch_last_object (/ obj minPt maxpt)
  (if (not
	 (vl-catch-all-error-p
	    (setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list (entlast))))
	 )
   )
   (progn
    (zoomObject obj)  ; zoom in to location where object is drawn
    obj
   )
  )
 ); featch_last_object
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***polyA (!LstP)
  (entmakex
    (append
      (list
	'(000 . "LWPOLYLINE")
	'(100 . "AcDbEntity")
	'(100 . "AcDbPolyline")
	(cons 90 (fix (length (cdr !LstP))))
	'(070 . 1)
	(cons 38 (caddr (trans '(0.0 0.0) 1 0)))
	)
      (mapcar
	(function
	  (lambda (X)
	    (cons 10 (trans X 1 (trans '(0.0 0.0 1.0) 1 0 t)))))
	!LstP)
      (list (cons 210 (trans '(0.0 0.0 1.0) 1 0 t)))
      )
    )
); ***polyA
; === === === === === === === === === === === === === === === === === === === === === === === ===
(defun ***polyB (lst / plist array)  
  (setq plist (apply 'append lst)	array (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (length plist))) plist))  
  (vla-AddPolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) array)
  (vla-put-Closed (vlax-ename->vla-object (entlast)) 1)
); ***polyB
; === === === === === === === === === === === === === === === === === === === === =
; write dcl on the fly
  (setq path (strcat (getvar "tempprefix") "JB-Sru.dcl") FileDCL (open path "w"))
  (write-line "Some : dialog {label = \"Something\";" FileDCL)
  (write-line ": radio_column {" FileDCL)
  (write-line ": radio_button {key = \"figA\"; label = \"figure A - CIRCLE\";}" FileDCL) ; draw circle
  (write-line ": radio_button {key = \"figB\"; label = \"figure B - SQUARE\";}" FileDCL) ; draw square
  (write-line ": radio_button {key = \"figC\"; label = \"figure C - LINE\";}}" FileDCL) ; add draw Line object
  (write-line "ok_only;}"  FileDCL)
  (close FileDCL)
;
; start main program
;
  (setq Cen (getvar "VIEWCTR")	dcl_id (load_dialog path)
        cmdecho (getvar"cmdecho") menuecho (getvar"menuecho")
  )
  (setvar "menuecho" 0) (setvar"cmdecho"0)
  (setq what_next 2)
  (while (> what_next 1)
    (if (not (new_dialog "Some" dcl_id "" '(-1 -1))); open dialog at center
     (exit)
    )
    
   (action_tile "figA" "(***figA)")
   (action_tile "figB" "(***figB)")
   (action_tile "figC" "(***figC)")

   ; (action_tile "figA" "(***figA) (if figB (vla-erase figB))")
   ; (action_tile "figB" "(***figB) (if figA (vla-erase figA))")
    
   (setq what_next (start_dialog))

   (cond
    ((= what_next 0) ; Cancel button picked
     nil
    ); case
    ((= what_next 1) ; OK button picked
     nil
    ); case
    ((= what_next 2) ; other button picked dismisses dialog
     (hilight T) ; highlight last object drawn
     (hilight nil) ; unhighlight last object drawn
    ); case
   ); cond
  ); while
   (unload_dialog dcl_id)  
   ;(acet-file-remove path)  ; this call is redundant cause each qqww the
                            ; dcl is opened for write thus override the file 
   (if path (vl-file-delete path)) ; deletes dcl
   (setvar "menuecho" menuecho)
   (setvar "cmdecho" cmdecho)(princ)
)(princ); c:qqww

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos

jerzy.bajor · ‎01-02-2023

So you can't see the effect without hiding the window?
As for the syntax, it was written quickly, so that it would only start.

Moshe-A · ‎01-03-2023

@jerzy.bajor ,

Yes, AutoLisp DCL supports only Modal forms. if you want Moduless, i suggest >> OpenDCL <<

beautiful Application By Owen Wengerd.

Moshe

Community

DCL Window

DCL Window

DCL Window