Help with DCL and Lisp with slides

May 16, 2017

Hi. I am trying to make a lisp to work through dcl with slides

I have a lisp file with 4 different lisp codes and i have one dcl file with 4 slides.I want when i click the slide the routine runs. look the attach *.zip file

Thanks

intersections.rar

May 16, 2017

There are some issue(s) in your dcl code, in the 2nd row its missing a double quote,

and after you define the dialog there are included are few spacers with the ok_cancel and errtile.

I think it should be formatted like this:

intersections : dialog 
{ label = "ΚΑΤΑΣΚΕΥΕΣ  ΣΗΜΕΙΩΝ                Topocad 2017";

 spacer_1;
 : text_part { label = "Επιλέξτε είδος Κατασκευής Σημείου :" ; alignment = left; }   
 spacer_1;
 
 : row
 { children_height = 8.0; children_width = 29.0; children_fixed_width = true; children_fixed_height = true;
   : image_button  { key = "me" ; color = graphics_background; }     
   : image_button { key = "te" ; color = graphics_background; }     
 }
 : row
 { children_height = 8.0; children_width = 29.0; children_fixed_width = true; children_fixed_height = true;
   : image_button  { key = "pse" ; color = graphics_background; }     
   : image_button { key = "tk" ; color = graphics_background; }     
 }
 spacer_1; ok_cancel; : errtile { width = 34; }
}

May 16, 2017

Hi Grrr.Thank for the reply.i do the change but is still not load dcl file

May 16, 2017

any ideas?

May 17, 2017

I had a quick look and you dont seem to be starting the image process and implying which image goes in which square. I will try to find some example code.

(start_image "icon_noi")
     (slide_image 0 0 (- (dimx_tile "icon_noi") 1) (- (dimy_tile "icon_noi") 1) "BIG-ALblank")
     (end_image)

May 17, 2017

hi BIGAL .Can you show me an example because i can not understand it.....

Thanks

May 17, 2017

I was wrong about children_height = 8.0; and children_width = 29.0; attributes, however heres an example:

; Slides Example
(defun C:test ( / L *error* dcl des dch dcf slidefiles r )
 
 (setq L 
   '(
     ("te" ; inter 
       ( 
         (lambda ( / o1 o2 )
           (and (setq o1 (car (entsel "\nFirst Object: "))) (setq o2 (car (entsel "\nSecond Object: ")))
             (foreach p (LM:Intersections (vlax-ename->vla-object o1) (vlax-ename->vla-object o2) acextendboth)
               (entmake (list '(0 . "POINT") (cons 10 p)))
             )
           )
         )
       )
     )
     ("tk" ; interset
       ( 
         (lambda ( SS ) (if SS (foreach p (LM:intersectionsinset SS) (entmake (list '(0 . "POINT") (cons 10 p))) ) ) )
         (progn (princ "\nSelect objects to intersect: ") (ssget) )
       )
     )
     ("pse" ; perpt
       ( 
         (lambda ( / dis enx pt1 pt2 pt3 sel tmp )
           (while
             (not
               (progn (setvar 'errno 0) (setq sel (entsel "\nSelect line or polyline segment: "))
                 (cond ( (= 7 (getvar 'errno)) (prompt "\nMissed, try again.") ) ( (null sel) )
                   ( (= "LINE" (cdr (assoc 0 (setq enx (entget (car sel))))))
                     (setq 
                       pt1 (trans (cdr (assoc 10 enx)) 0 1)
                       pt2 (trans (cdr (assoc 11 enx)) 0 1)
                       dis (distance pt1 pt2)
                     )
                   )
                   ( (= "LWPOLYLINE" (cdr (assoc 0 enx)))
                     (setq 
                       tmp (vlax-curve-getclosestpointto (car sel) (trans (cadr sel) 1 0))
                       tmp (fix (+ 1e-8 (vlax-curve-getparamatpoint (car sel) tmp)))
                       pt1 (trans (vlax-curve-getpointatparam (car sel)     tmp)  0 1)
                       pt2 (trans (vlax-curve-getpointatparam (car sel) (1+ tmp)) 0 1)
                       dis (distance pt1 pt2)
                     )
                   )
                   ( (prompt "\nThe selected object is not a line or 2D polyline.") )
                 )
               )
             )
           )
           (if (and pt1 pt2 (setq pt3 (getpoint "\nSpecify 3rd point: ")))
             (entmake
               (list '(000 . "POINT") '(008 . "section")
                 (cons 010 (trans (polar pt1 (angle pt1 pt2) (apply '+ (mapcar '* (mapcar '- pt3 pt1) (mapcar '(lambda ( a b ) (/ (- a b) dis)) pt2 pt1) ) ) ) 1 0) )
                 (cons 210 (trans '(0 0 1) 1 0 t))
               )
             )
           )
           (princ)
         )
       )
     )
     ("me" ; MidPl
       ( 
         (lambda ( / e enx o prm mp )
           (and
             (setq e (car (entsel "\nSelect line: "))) (setq enx (entget e))
             (member (cdr (assoc 0 enx)) '("POLYLINE" "LWPOLYLINE" "LINE"))
             (setq o (vlax-ename->vla-object e)) (setq prm (vlax-curve-getEndParam o))
             (setq mp (vlax-curve-getPointAtDist o (* 0.5 (vlax-curve-getDistAtParam o prm))))
             (entmake (list '(0 . "POINT") (cons 10 mp)))
             (princ (strcat "\nPoint object created at mid-point: " (vl-prin1-to-string mp))) (princ)
           )
         )
       )
     )
   ); list
 ); setq L 
 
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
   (princ)
 ); defun *error*
 
 
 (cond
   ( 
     (progn 
       (setq slidefiles (mapcar '(lambda (x) (strcat x ".sld")) '("me" "te" "pse" "tk"))) ; <- adjust slidernames
       (vl-some '(lambda (x) (if (not (findfile x)) (princ (strcat "\nUnable to find \"" x "\" file.")))) slidefiles) 
     )
   )
   (
     (not
       (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
         (princ 
           (apply 'strcat
             (mapcar (function (lambda (x) (apply 'strcat (mapcar 'chr x))))
               '(
                 (116 101 115 116 32 58 32 100 105 97 108 111 103 32) (123 32 108 97 98 101 108 32 61 32 34 73 110 116 101 114 115 101 99 116 105 111 110 115 34 59)
                 (32 32 58 32 98 111 120 101 100 95 99	111 108	117 109	110 32)
                 (32 32 123 32 108 97 98 101 108 32 61	32 34 67 104 111	111 115 101 32 97 99 116 105 111 110 34 59 32	115 112 97 99 101 114 95 49	59)
                 (32 32 32 32 58 32 114 111 119 32)
                 (32 32 32	32 123 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 119 105 100 116 104 32 61 32	116 114 117 
                   101 59 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 104 101 105 103 104 116 32 61 32 116 114 117 101 59
                 )
                 (32 32 32	32 32 32 58 32 105 109 97 103 101 95 98 117	116 116 111 110 32 32 123 32 107 101 121 32 61 32 34 109 101 34 59 32 104	101 105 103
                   104 116	32   61	  32   49   50	 59   32   119	105  100  116 104 32	61   32	  51   50   59	 32   99   111	108  111  114
                   32 61	32   103  114  97   112	 104  105  99	115  95	  98 97 99	107  103  114  111  117	 110  100  59	32   125
                 )
                 (32 32 32	32 32 32   58   32	 105  109  97	103  101  95 98 117 116 116  111  110  32	 123  32   107	101  121  32
                   61 32	34 116 101  34   59	 32   104  101	105  103  104 116 32	61 32	  49   50   59	 32   119  105	100  116  104
                   32 61	32 51 50   59   32	 99   111  108	111  114  32 61 32	103 114  97   112  104	 105  99   115	95   98	  97
                   99 107	103  114  111  117  110	 100  59   32	125
                 )
                 (32 32 32 32 125) (32 32 32 32 58 32 114 111 119 32)
                 (32 32   32	32   123  32   99   104	 105  108  100	114  101  110 95   102	105  120  101  100  95	 119  105  100	116  104  32
                   61   32	116  114  117  101  59	 32   99   104	105  108  100 114  101	110  95	  102  105  120	 101  100  95	104  101  105
                   103  104	116  32	  61   32   116	 114  117  101	59
                 )
                 (32 32   32	32   32	  32   58   32	 105  109  97	103  101  95 98 117	116  116  111  110  32	 32   123  32	107  101  121
                   32   61	32   34	  112  115  101	 34   59   32	104  101  105 103  104	116  32	  61   32   49	 50   59   32	119  105  100
                   116  104	32   61	  32   51   50	 59   32   99	111  108  111 114  32	61   32	  103  114  97	 112  104  105	99   115  95
                   98   97	99   107  103  114  111	 117  110  100	59   32	  125
                 )
                 (32 32   32	32   32	  32   58   32	 105  109  97	103  101  95 98   117	116  116  111  110  32	 123  32   107	101  121  32
                   61   32	34   116  107  34   59	 32   104  101	105  103  104 116  32	61   32	  49   50   59	 32   119  105	100  116  104
                   32   61	32   51	  50   59   32	 99   111  108	111  114  32 61   32	103  114  97   112  104	 105  99   115	95   98	  97
                   99   107	103  114  111  117  110	 100  59   32	125
                 )
                 (32 32 32 32 125) (32 32 125)
                 (32 32 115 112 97 99 101 114 95 49 59 32 111 107 95 111 110 108 121 59 32 58 32 116 101 120
                   116 32 123 32 108 97 98 101 108 32 61 32 34 67 114 101 100 105 116 115 32 116 111 58 32 76
                   101 101 32 77 97 99 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 114 105 103 104 116 59 32 125
                 )
                 (125)
               )
             )
           )
           des
         )
         (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
       ); and
     ); not
     (princ "\nUnable to write or load the DCL file.")
   )
   ( (not (new_dialog "test" dch)) (princ "\nUnable to display the dialog") )
   (
     (progn 
       (mapcar (function (lambda (x) (action_tile x (vl-prin1-to-string '(progn (done_dialog 1) (setq r $key)))))) '("me" "te" "pse" "tk") )
       (mapcar 
         (function
           (lambda ( key sld / w h ) ; (slide_image x1 y1 width height sldname)
             (setq w (1- (dimx_tile key))) (setq h (1- (dimy_tile key)))  
             (start_image key) (fill_image 0 0 w h 0) (slide_image 0 0 w h sld) (end_image) ; (fill_image ...) might be redundant
             ; (start_image "me") (slide_image 0 0 (1- (dimx_tile "me")) (1- (dimy_tile "me")) "SlideName.sld") (end_image)
           )
         )
         '("me" "te" "pse" "tk") slidefiles
       )
       (action_tile "accept" (vl-prin1-to-string '(progn (princ "\nBye!") (done_dialog 2))))
       (/= 1 (setq dcf (start_dialog)))
     ); progn
     (princ) ; (princ "\nUser cancelled the dialog.")
   )
   (T (eval (cadr (assoc r L))) )
 ); cond
 (*error* nil) (princ) 
); defun 



;;--------------------=={ Intersections }==-------------------;;
;;                                                            ;;
;;  Returns a list of all points of intersection between      ;;
;;  two objects for the given intersection mode.              ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  obj1, obj2 - VLA-Objects                                  ;;
;;  mode       - acextendoption enum of intersectwith method  ;;
;;------------------------------------------------------------;;
;;  Returns:  List of intersection points, or nil             ;;
;;------------------------------------------------------------;;

(defun LM:Intersections ( obj1 obj2 mode / l r )
 (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length l) 3)
   (setq r (cons (list (car l) (cadr l) (caddr l)) r)
     l (cdddr l)
   )
 )
 (reverse r)
)


;; Intersections in Set  -  Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
 (repeat (setq id1 (sslength sel))
   (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
   (repeat (setq id2 id1)
     (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
       rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
     )
   )
 )
 (apply 'append (reverse rtn))
)

May 17, 2017

Grrr thank you for the help. can you explain me what is all this numbers? You use any program to do this?

(mapcar (function (lambda (x) (apply 'strcat (mapcar 'chr x))))
               '(
                 (116 101 115 116 32 58 32 100 105 97 108 111 103 32) (123 32 108 97 98 101 108 32 61 32 34 73 110 116 101 114 115 101 99 116 105 111 110 115 34 59)
                 (32 32 58 32 98 111 120 101 100 95 99	111 108	117 109	110 32)
                 (32 32 123 32 108 97 98 101 108 32 61	32 34 67 104 111	111 115 101 32 97 99 116 105 111 110 34 59 32	115 112 97 99 101 114 95 49	59)
                 (32 32 32 32 58 32 114 111 119 32)
                 (32 32 32	32 123 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 119 105 100 116 104 32 61 32	116 114 117 
                   101 59 32 99 104 105 108 100 114 101 110 95 102 105 120 101 100 95 104 101 105 103 104 116 32 61 32 116 114 117 101 59
                 )
                 (32 32 32	32 32 32 58 32 105 109 97 103 101 95 98 117	116 116 111 110 32 32 123 32 107 101 121 32 61 32 34 109 101 34 59 32 104	101 105 103
                   104 116	32   61	  32   49   50	 59   32   119	105  100  116 104 32	61   32	  51   50   59	 32   99   111	108  111  114
                   32 61	32   103  114  97   112	 104  105  99	115  95	  98 97 99	107  103  114  111  117	 110  100  59	32   125
                 )
                 (32 32 32	32 32 32   58   32	 105  109  97	103  101  95 98 117 116 116  111  110  32	 123  32   107	101  121  32
                   61 32	34 116 101  34   59	 32   104  101	105  103  104 116 32	61 32	  49   50   59	 32   119  105	100  116  104
                   32 61	32 51 50   59   32	 99   111  108	111  114  32 61 32	103 114  97   112  104	 105  99   115	95   98	  97
                   99 107	103  114  111  117  110	 100  59   32	125
                 )
                 (32 32 32 32 125) (32 32 32 32 58 32 114 111 119 32)
                 (32 32   32	32   123  32   99   104	 105  108  100	114  101  110 95   102	105  120  101  100  95	 119  105  100	116  104  32
                   61   32	116  114  117  101  59	 32   99   104	105  108  100 114  101	110  95	  102  105  120	 101  100  95	104  101  105
                   103  104	116  32	  61   32   116	 114  117  101	59
                 )
                 (32 32   32	32   32	  32   58   32	 105  109  97	103  101  95 98 117	116  116  111  110  32	 32   123  32	107  101  121
                   32   61	32   34	  112  115  101	 34   59   32	104  101  105 103  104	116  32	  61   32   49	 50   59   32	119  105  100
                   116  104	32   61	  32   51   50	 59   32   99	111  108  111 114  32	61   32	  103  114  97	 112  104  105	99   115  95
                   98   97	99   107  103  114  111	 117  110  100	59   32	  125
                 )
                 (32 32   32	32   32	  32   58   32	 105  109  97	103  101  95 98   117	116  116  111  110  32	 123  32   107	101  121  32
                   61   32	34   116  107  34   59	 32   104  101	105  103  104 116  32	61   32	  49   50   59	 32   119  105	100  116  104
                   32   61	32   51	  50   59   32	 99   111  108	111  114  32 61   32	103  114  97   112  104	 105  99   115	95   98	  97
                   99   107	103  114  111  117  110	 100  59   32	125
                 )
                 (32 32 32 32 125) (32 32 125)
                 (32 32 115 112 97 99 101 114 95 49 59 32 111 107 95 111 110 108 121 59 32 58 32 116 101 120
                   116 32 123 32 108 97 98 101 108 32 61 32 34 67 114 101 100 105 116 115 32 116 111 58 32 76
                   101 101 32 77 97 99 34 59 32 97 108 105 103 110 109 101 110 116 32 61 32 114 105 103 104 116 59 32 125
                 )
                 (125)
               )

May 17, 2017

Thats just the DCL code - hardcoded a bit - to prevent easy removal of Lee Mac's nickname.

Since all or almost all of the subfunctions provided and the overall dcl-on-the-fly technique were demonstrated by him, so practically his presence is in ~90% of the code.

A bit of appreciation would be nice (instead of assembling his codes posted in different threads and claiming for authority).

May 17, 2017

I din't have problem with the LeeMac nickname just ask how i can do it.is any command throu autocad visual lisp or i need another program. Is any program can help me with the dcl , to draw the form i need and give me the code? (like visual basic?)

May 18, 2017

I am lucky and have a copy of Autocad release 12 (not 2012) help manual and it has all the sample code for doing dcl's

this is still available in the Autocad Help but you have to find it. Once you get an idea of what you want its not that hard, I have dcl's with sub dcls yes you can call another dcl level, they have stuff like sliders so you can drag for answers required.

Start here https://knowledge.autodesk.com/support/autocad-civil-3d/learn-explore/caas/CloudHelp/cloudhelp/2018/ENU/AutoCAD-AutoLISP/files/GUID-E10AFB89-89BF-4616-819A-439BAEAAD0B9-htm.html

If you post a dwg of what you want the dcl to look like we may be able to help.

Edited May 18, 2017 by BIGAL

May 18, 2017

How i hardcoded a DCL code ? is any program to do this?

May 18, 2017

Hi Grrr.I want to ask you a question.If i understand all the DCL file is hardcoded. If i want to add some other intersections in the same project and have 4 lines and 5 rows is not possible ?

May 18, 2017

Yes I have default dcl for slides 2x2 3x2 4x4 etc its just a case of adding more rows and columns. In the example below each image has a key ID like "33sq1" the images are supplied as a list ("slide1" "slide2" ...) via a lisp using a 33sq+x where x starts at 1 and you repeat to populate the images. This was done as a library routine so can work with any program returning some value for the square picked. I will try to find the correct code to call the dcl its at home.

//  DD3x3 dialogue.  Used by DD3x3.lsp.
//  By Alan H 1990.
dd3x3 : dialog {
 label        = "Please choose item";
 : column {
   : row {
     : image_button {
       key          = "33sq1";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     : image_button {
       key          = "33sq2";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     : image_button {
       key          = "33sq3";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
   }
   : row {
     : image_button {
       key          = "33sq4";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     : image_button {
       key          = "33sq5";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     : image_button {
       key          = "33sq6";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     }
     : row {
     : image_button {
       key          = "33sq7";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     : image_button {
       key          = "33sq8";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     : image_button {
       key          = "33sq9";
       width        = 10;
       aspect_ratio = 1.0;
       color        = 0;
       allow_accept = true;
     }
     }
 }
ok_cancel;
}

Sign In

Help with DCL and Lisp with slides

Recommended Posts

Guest

Grrr

Guest

Guest

BIGAL

Guest

Grrr

Guest

Grrr

Guest

BIGAL

Guest

Guest

BIGAL

Join the conversation

Tutorials

Forums

Activity