Author Topic: Link DCL with lisp  (Read 5668 times)

0 Members and 1 Guest are viewing this topic.

pedroantonio

  • Guest
Link DCL with lisp
« on: October 17, 2019, 06:59:17 AM »
Hi i have this lisp file to check if the layers in the drawing is correct. I want to create a DCL and link in with the code. The dcl file i want (like the photo) to have tick box and give me the option to select  more han one (in some cases i will check them all)


Thanks

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #1 on: October 17, 2019, 11:09:50 PM »
Have a look at this its a library routine can be used in any code just save Multi getvals to a Autocad supported directory.

Any character entered is do pick. Or look at help for radio button dcl. You can break sown the list ans  for each answer just check (/= (nth 0 ans) "") and so on.

Code: [Select]
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Change blank for yes " "Blocks"  5 4 "" "Dimension" 5 4 "" "Hatch" 5 4 "" "Images" 5 4 "" "Viewports" 5 4 "")))

I have a multi radio buttons but its a pick one in replace of initget. Will have a look at pick multiple can use same method just need change multiple pick.
« Last Edit: October 17, 2019, 11:13:15 PM by BIGAL »
A man who never made a mistake never made anything

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #2 on: October 19, 2019, 12:45:51 AM »
Have a look at my last post now done using toggles. code for you. Download at Cadtutor.net Multiple toggles.lsp

Code: [Select]
; add file path to load if required
(if (not AH:Toggs)(load "Multiple toggles.lsp")))
(setq ans (ah:toggs   '("Tick off/on " "Blocks" "Dimension" "Hatch" "Images" "Viewports")))

You get a list ans that will have 0 & 1 for on off in same order as the strings above. So do a cond using (= (nth 0 ans) 1) (= (nth 1 ans) 1) etc
A man who never made a mistake never made anything

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #3 on: October 19, 2019, 03:02:24 AM »
Hi bigal. Can you help me to link the dcl file with the lisp code. Actualy is 5 diferent lisps in one file

Some layer names  is in Greek language never mine i fix them later.

Thanks

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #4 on: October 19, 2019, 06:39:11 PM »
1st The if not loads the multi program so it can be used in any program it just must be saved somewhere in the support paths or add your saved location. It can have as many toggles as you like just add more to the list.
eg  (if (not AH:Toggs)(load "c:\\mylisp\\programs\\Multiple toggles.lsp")))

ans will return a list like ("0" "1" "0" "1" "0")
Code: [Select]
; must match the list order
(if (not AH:Toggs)(load "Multiple toggles.lsp")))
(setq ans (ah:toggs   '("Tick off/on " "Blocks" "Dimension" "Hatch" "Images" "Viewports")))

(if (= (nth 0 ans) "1") (c:LinkLayerBlock )) ;  Blocks
(if (= (nth 1 ans) "1") (c:DLDL)) ;dimension
(if (= (nth 2 ans) "1") (c:DLHATCH)) ;hatch
(if (= (nth 3 ans) "1") (c:LinkLayerImage)) ;Images
(if (= (nth 4 ans) "1") (c:LV)) ;Viewports
« Last Edit: October 21, 2019, 08:28:30 PM by BIGAL »
A man who never made a mistake never made anything

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #5 on: October 19, 2019, 06:44:33 PM »
i can not understand it. I want to see an example

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #6 on: October 20, 2019, 02:39:15 AM »
Just add the code posted to the bottom of your code. If you use appload it should just self run.
A man who never made a mistake never made anything

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #7 on: October 20, 2019, 11:29:24 AM »
Hi BIGAL. I try it but is not working !!!. Perhaps i do somethig wrong  :oops: .Can we put them all in one file ?


Code - Auto/Visual Lisp: [Select]
  1. ; for blocks
  2.  
  3. (defun c:LinkLayerBlock ( / enx idx lay map sel )
  4.     (setq
  5.         map
  6.        '(
  7. ;points
  8.  
  9.             ("KORYFES" . "ΑΞΟΝΟΔΙΑΣΤΑΥΡΩΣΗ")
  10.             ("KOROT" . "ΚΟΡΥΦΗ ΟΤ")
  11.             ("KOKAEK" . "ΣΗΜΕΙΟ ΚΑΕΚ")
  12.             ("odsta" . "ΟΔΕΥΣΗ")
  13.             ("odtrig" . "ΟΔΕΥΣΗ")
  14.             ("REPERS" . "REPERS")
  15.             ("station" . "ΣΤΑΣΗ")
  16.             ("point" . "ΤΑΧΥΜΕΤΡΙΚΑ")
  17.             ("trigonom" . "ΤΡΙΓΩΝΟΜΕΤΡΙΚΑ")
  18.             ("MES" . "MES")
  19.             ("Podi" . "ΠΟΔΙ")
  20.             ("Fridi" . "φΡΥΔΙ")
  21.             ("Ypsom" . "ΤΥΧΑΙΟ_ΥΨΟΜΕΤΡΟ")
  22.             ("Dexia" . "ΔΕΞΙΑ")
  23.             ("Aristera" . "ΑΡΙΣΤΕΡΑ")
  24.             ("Dianomi" . "ΔΙΑΝΟΜΗ")
  25.            
  26. ;trees
  27.  
  28.             ("tree1" . "ΔΕΝΤΡΟ")
  29.             ("tree2" . "ΔΕΝΤΡΟ")
  30.             ("tree3" . "ΔΕΝΤΡΟ")
  31.             ("tree4" . "ΔΕΝΤΡΟ")
  32.             ("tree5" . "ΔΕΝΤΡΟ")
  33.             ("tree6" . "ΚΥΠΑΡΙΣΣΙ")
  34.             ("tree7" . "ΚΥΠΑΡΙΣΣΙ")
  35.             ("tree8" . "ΦΟΙΝΙΚΑΣ")
  36.             ("tree9" . "ΦΟΙΝΙΚΑΣ")
  37.             ("tree10" . "ΕΛΑΤΟ")
  38.             ("tree11" . "ΑΜΠΕΛΙ")
  39.             ("tree12" . "ΕΛΙΑ")
  40.             ("tree13" . "ΕΣΠΕΡΙΔΟΕΙΔΗ")
  41.  
  42. ;symbols
  43.  
  44.             ("ARID1" . "ΑΡΙΘ. ΙΔΙΟΚΤΗΣΙΑΣ")
  45.             ("AROT1" . "Ο.Τ")
  46.             ("velos" . "ΒΕΛΟΣ")
  47.             ("dvelos" . "ΔΙΠΛΟ ΒΕΛΟΣ")
  48.             ("NORTH" . "ΒΟΡΡΑΣ")
  49.             ("vrisi" . "ΒΡΥΣΗ")
  50.             ("vana" . "ΒΑΝΑ")
  51.             ("DEH1" . "ΔΕΗ")
  52.             ("Eikonastasi" . "ΕΙΚΟΝΟΣΤΑΣΙ")
  53.             ("kamera" . "ΚΑΜΕΡΑ")
  54.             ("MPASKETA" . "ΜΠΑΣΚΕΤΑ")
  55.             ("OTE1" . "ΟΤΕ")
  56.             ("krounos" . "ΚΡΟΥΝΟΣ")
  57.             ("stathmi" . "ΣΤΑΘΜΕΣ")
  58.             ("stayros" . "ΣΤΑΥΡΟΣ")
  59.             ("simaia" . "ΣΗΜΑΙΑ")
  60.             ("THL1" . "ΤΗΛ. ΘΑΛΑΜΟΣ")
  61.             ("fanari" . "ΦΑΝΑΡΙ ΚΥΚΛΟΦΟΡΙΑΣ")
  62.             ("pinakida" . "ΠΙΝΑΚΙΔΑ - ΤΑΜΠΕΛΑ")
  63.             ("shma1" . "ΣΗΜΑ_ΤΡΙΓ")
  64.             ("shma2" . "ΣΗΜΑ_ΣΤΡΟΓ")
  65.             ("shma3" . "ΣΗΜΑ_ΕΞΑΓ")
  66.             ("shma4" . "ΣΗΜΑ_ΤΕΤΡ")
  67.             ("PETRA1" . "ΠΕΤΡΑ")
  68.             ("PETRA2" . "ΠΕΤΡΑ")
  69.             ("PETRA3" . "ΠΕΤΡΑ")
  70.             ("PETRA4" . "ΠΕΤΡΑ")
  71.             ("FANMONO" . "ΦΑΝΑΡΑΡΑΚΙ ΜΟΝΟ")
  72.             ("FANDIPLO" . "ΦΑΝΑΡΑΡΑΚΙ ΔΙΠΛΟ")
  73.             ("FANTRIPLO" . "ΦΑΝΑΡΑΡΑΚΙ ΤΡΙΠΛΟ")
  74.             ("FANMONO2" . "ΣΤΥΛΟΣ ΦΩΤΙΣΜΟΥ ΜΟΝΟΣ")
  75.             ("fos1" . "ΦΩΤΙΣΜΟΣ ΟΔΟΥ")  
  76.  
  77. ;Annotation points
  78.  
  79.             ("AnnotKORYFES" . "_ΑΞΟΝΟΔΙΑΣΤΑΥΡΩΣΗ")
  80.             ("AnnotKOROT" . "_ΚΟΡΥΦΗ ΟΤ")
  81.             ("AnnotKOKAEK" . "_ΣΗΜΕΙΟ ΚΑΕΚ")
  82.             ("Annotodsta" . "_ΟΔΕΥΣΗ")
  83.             ("Annotodtrig" . "_ΟΔΕΥΣΗ")
  84.             ("AnnotREPERS" . "_REPERS")
  85.             ("Annotstation" . "_ΣΤΑΣΗ")
  86.             ("Annotpoint" . "_ΤΑΧΥΜΕΤΡΙΚΑ")
  87.             ("Annottrigonom" . "_ΤΡΙΓΩΝΟΜΕΤΡΙΚΑ")
  88.             ("AnnotMes" . "_MES")
  89.             ("AnnotPodi" . "_ΠΟΔΙ")
  90.             ("AnnotFridi" . "_φΡΥΔΙ")
  91.             ("AnnotYpsom" . "_ΤΥΧΑΙΟ_ΥΨΟΜΕΤΡΟ")
  92.             ("AnnotDexia" . "_ΔΕΞΙΑ")
  93.             ("AnnotAristera" . "_ΑΡΙΣΤΕΡΑ")
  94.             ("AnnotDianomi" . "_ΔΙΑΝΟΜΗ")
  95.  
  96.  
  97. ;Annotation trees
  98.  
  99.             ("annottree1" . "_ΔΕΝΤΡΟ")
  100.             ("annottree2" . "_ΔΕΝΤΡΟ")
  101.             ("annottree3" . "_ΔΕΝΤΡΟ")
  102.             ("annottree4" . "_ΔΕΝΤΡΟ")
  103.             ("annottree5" . "_ΔΕΝΤΡΟ")
  104.             ("annottree6" . "_ΚΥΠΑΡΙΣΣΙ")
  105.             ("annottree7" . "_ΚΥΠΑΡΙΣΣΙ")
  106.             ("annottree8" . "_ΦΟΙΝΙΚΑΣ")
  107.             ("annottree9" . "_ΦΟΙΝΙΚΑΣ")
  108.             ("annottree10" . "_ΕΛΑΤΟ")
  109.             ("annottree11" . "_ΑΜΠΕΛΙ")
  110.             ("annottree12" . "_ΕΛΙΑ")
  111.             ("annottree13" . "_ΕΣΠΕΡΙΔΟΕΙΔΗ")
  112.  
  113. ;Annotation symbols
  114.  
  115.             ("AnnotARID1" . "_ΑΡΙΘ. ΙΔΙΟΚΤΗΣΙΑΣ")
  116.             ("AnnotAROT1" . "_Ο.Τ")
  117.             ("Annotvelos" . "_ΒΕΛΟΣ")
  118.             ("Annotdvelos" . "_ΔΙΠΛΟ ΒΕΛΟΣ")
  119.             ("AnnotNORTH" . "_ΒΟΡΡΑΣ")
  120.             ("Annotvrisi" . "_ΒΡΥΣΗ")
  121.             ("Annotvana" . "_ΒΑΝΑ")
  122.             ("AnnotDEH1" . "_ΔΕΗ")
  123.             ("AnnotEikonastasi" . "_ΕΙΚΟΝΟΣΤΑΣΙ")
  124.             ("mscale" . "ΚΛΙΜΑΚΑ")
  125.             ("Annotkamera" . "_ΚΑΜΕΡΑ")
  126.             ("AnnotMPASKETA" . "_ΜΠΑΣΚΕΤΑ")
  127.             ("raga" . "ΟΣΕ")
  128.             ("AnnotOTE1" . "_ΟΤΕ")
  129.             ("Annotkrounos" . "_ΚΡΟΥΝΟΣ")
  130.             ("Annotstathmi" . "_ΣΤΑΘΜΕΣ")
  131.             ("Annotstayros" . "_ΣΤΑΥΡΟΣ")
  132.             ("Annotsimaia" . "_ΣΗΜΑΙΑ")
  133.             ("AnnotTHL1" . "_ΤΗΛ. ΘΑΛΑΜΟΣ")
  134.             ("Annotfanari" . "_ΦΑΝΑΡΙ ΚΥΚΛΟΦΟΡΙΑΣ")
  135.             ("ARI_KAN" . "Κάνναβος_Συντ")
  136.             ("grtick" . "Κάνναβος_Σταυρός")
  137.             ("Annotpinakida" . "_ΠΙΝΑΚΙΔΑ - ΤΑΜΠΕΛΑ")
  138.             ("Annotshma1" . "_ΣΗΜΑ_ΤΡΙΓ")
  139.             ("Annotshma2" . "_ΣΗΜΑ_ΣΤΡΟΓ")
  140.             ("Annotshma3" . "_ΣΗΜΑ_ΕΞΑΓ")
  141.             ("Annotshma4" . "_ΣΗΜΑ_ΤΕΤΡ")
  142.             ("AnnotPETRA1" . "_ΠΕΤΡΑ")
  143.             ("AnnotPETRA2" . "_ΠΕΤΡΑ")
  144.             ("AnnotPETRA3" . "_ΠΕΤΡΑ")
  145.             ("AnnotPETRA4" . "_ΠΕΤΡΑ")
  146.             ("AnnotFANMONO" . "_ΦΑΝΑΡΑΡΑΚΙ ΜΟΝΟ")
  147.             ("AnnotFANDIPLO" . "_ΦΑΝΑΡΑΡΑΚΙ ΔΙΠΛΟ")
  148.             ("AnnotFANTRIPLO" . "_ΦΑΝΑΡΑΡΑΚΙ ΤΡΙΠΛΟ")
  149.             ("AnnotFANMONO2" . "_ΣΤΥΛΟΣ ΦΩΤΙΣΜΟΥ ΜΟΝΟΣ")
  150.             ("Annotfos1" . "_ΦΩΤΙΣΜΟΣ ΟΔΟΥ")          
  151.  
  152.         )
  153.         map (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) map)
  154.     )
  155.     (if
  156.         (setq sel
  157.             (ssget "_X"
  158.                 (append
  159.                    '(
  160.                         ( 0 . "INSERT")
  161.                         (-4 . "<OR")
  162.                         ( 2 . "`*U*")
  163.                     )
  164.                     (mapcar '(lambda ( x ) (cons 2 (car x))) map)
  165.                    '(
  166.                         (-4 . "OR>")
  167.                     )
  168.                 )
  169.             )
  170.         )
  171.         (repeat (setq idx (sslength sel))
  172.             (setq enx (entget (ssname sel (setq idx (1- idx)))))
  173.             (if (setq lay (cdr (assoc (strcase (LM:name->effectivename (cdr (assoc 2 enx)))) map)))
  174.                 (entmod (subst (cons 8 lay) (assoc 8 enx) enx))
  175.             )
  176.         )
  177.     )
  178.     (princ)
  179. )
  180.  
  181. ;; Block Name -> Effective Block Name  -  Lee Mac
  182. ;; blk - [str] Block name
  183.  
  184. (defun LM:name->effectivename ( blk / rep )
  185.     (if
  186.         (and (wcmatch blk "`**")
  187.             (setq rep
  188.                 (cdadr
  189.                     (assoc -3
  190.                         (entget
  191.                             (cdr (assoc 330 (entget (tblobjname "block" blk))))
  192.                            '("AcDbBlockRepBTag")
  193.                         )
  194.                     )
  195.                 )
  196.             )
  197.             (setq rep (handent (cdr (assoc 1005 rep))))
  198.         )
  199.         (cdr (assoc 2 (entget rep)))
  200.         blk
  201.     )
  202. )
  203.  
  204.  
  205.  
  206. ;;;;;;;;;; for images
  207.  
  208.  
  209. (defun c:LinkLayerImage (/ *error* acDoc layerName oLayer ss)
  210.  
  211.   (defun *error* (msg)
  212.     (if ss
  213.       (vla-delete ss)
  214.     )
  215.     (if acDoc
  216.       (progn
  217.         (vla-endundomark acDoc)
  218.         (vla-regen acDoc acallviewports)
  219.       )
  220.     )
  221.     (cond ((not msg))                                                   ; Normal exit
  222.           ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
  223.           ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
  224.     )
  225.     (princ)
  226.   )
  227.  
  228.   (if (ssget "_X" '((0 . "IMAGE") (8 . "~Image")))
  229.     (progn
  230.       )
  231.  
  232.       ;; get or create layer
  233.       (setq oLayer
  234.              (vla-add (vla-get-layers acDoc) (setq layerName "Image"))
  235.       )
  236.  
  237.       ;; set image layer
  238.       (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
  239.         (vla-put-layer x layerName)
  240.       )
  241.  
  242.       (setvar 'clayer "Line1")
  243.     )
  244. )
  245.  
  246.   (*error* nil)
  247. )
  248.  
  249.  
  250. ;;;;;;;;;; for DIMENSIONS
  251.  
  252.     (defun c:DLDL (/ sel1 CLAYER )
  253. ;Switch from Layout Tab To Model Tab before stating LISP
  254.     (command "_.Tilemode" 1) ; To model space
  255.     (setq sel1 (ssget "X" '((0 . "DIMENSION")))) ; SELECT ALL DIMENSION
  256.     (setq OLDLAYER (getvar "CLAYER")) ;GET CURRENT LAYER
  257.     (COMMAND "_layer" "_m" "DIM" "_c" "10""" "") ;CREATE NEW LAYER
  258.     (setvar "CLAYER" OLDLAYER) ; SET ACTIVE LAYER TO PREVIOUS
  259.     (command "CHPROP" sel1 "" ; CHANGE DIMENSION LAYER TO NEW LAYER
  260.     "LAYER" "DIM"
  261.     "")
  262.    (command "_.Tilemode" 0) ;And back to last current layout
  263.     );END PROGRAM
  264.  
  265.  
  266. ;;;;;;;;;;for HATCH
  267.  
  268.     (defun c:DLHATCH (/ sel1 CLAYER )
  269. ;Switch from Layout Tab To Model Tab before stating LISP
  270.     (command "_.Tilemode" 1) ; To model space
  271.     (setq sel1 (ssget "X" '((0 . "HATCH")))) ; SELECT ALL HATCH
  272.     (setq OLDLAYER (getvar "CLAYER")) ;GET CURRENT LAYER
  273.     (COMMAND "_layer" "_m" "HATCH" "_c" "155" "" "_lw" "0.18" "" "") ;CREATE NEW LAYER
  274.     (setvar "CLAYER" OLDLAYER) ; SET ACTIVE LAYER TO PREVIOUS
  275.     (command "CHPROP" sel1 "" ; CHANGE HATCH LAYER TO NEW LAYER
  276.     "LAYER" "HATCH"
  277.     "")
  278.    (command "_.Tilemode" 0) ;And back to last current layout
  279.  
  280.     (setq sel1 (ssget "X" '((0 . "HATCH")))) ; SELECT ALL HATCH
  281.     (setq OLDLAYER (getvar "CLAYER")) ;GET CURRENT LAYER
  282.     (COMMAND "_layer" "_m" "HATCH" "_c" "155" "" "_lw" "0.18" "" "") ;CREATE NEW LAYER
  283.     (setvar "CLAYER" OLDLAYER) ; SET ACTIVE LAYER TO PREVIOUS
  284.     (command "CHPROP" sel1 "" ; CHANGE HATCH LAYER TO NEW LAYER
  285.     "LAYER" "HATCH"
  286.     "")
  287.     );END PROGRAM
  288.  
  289.  
  290. ;;;;;;;;;; for VIEPORTS
  291.  
  292.     (defun c:LV ( / idx lay obj sel )
  293.        
  294.         (setq lay "VIEWPORT") ;; Viewport Layer
  295.      
  296.         (if (setq sel (ssget "_X" (list '(0 . "VIEWPORT") (cons 8 (strcat "~" lay)))))
  297.             (progn
  298.                 (if (not (tblsearch "layer" lay))
  299.                     (entmake
  300.                         (list
  301.                            '(000 . "LAYER")
  302.                            '(100 . "AcDbSymbolTableRecord")
  303.                            '(100 . "AcDbLayerTableRecord")
  304.                            '(070 . 0)
  305.                             (cons 2 lay)
  306.                         )
  307.                     )
  308.                 )
  309.                 (repeat (setq idx (sslength sel))
  310.                     (setq idx (1- idx)
  311.                           obj (vlax-ename->vla-object (ssname sel idx))
  312.                     )
  313.                     (if (vlax-write-enabled-p obj) (vla-put-layer obj lay))
  314.                 )
  315.             )
  316.         )
  317.         (princ)
  318.     )
  319.     (vl-load-com) (princ)
  320.  
  321. ;load dcl lisp
  322.  
  323. (defun c:mylayer ()
  324. ; must match the list order
  325. (if (not AH:Toggs)(load "Multiple toggles.lsp")))
  326. (setq ans (ah:toggs   '("Tick off/on " "Blocks" "Dimension" "Hatch" "Images" "Viewports")))
  327.  
  328. (if (= (nth 0 ans) 1) (c:LinkLayerBlock )) ;  Blocks
  329. (if (= (nth 1 ans) 1) (c:DLDL)) ;dimension
  330. (if (= (nth 2 ans) 1) (c:DLHATCH)) ;hatch
  331. (if (= (nth 3 ans) 1) (c:LinkLayerImage)) ;Images
  332. (if (= (nth 4 ans) 1) (c:LV)) ;Viewports
  333. )
  334.  


Code - Auto/Visual Lisp: [Select]
  1. ; Multi toggle Dialog box for multi choice
  2. ; By Alan H Oct 2019
  3.  
  4. ; Example code
  5. ; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
  6. ; (setq ans (ah:toggs   '("Yes or No" "Yes" "No")))
  7.  
  8. ; (if (not AH:Toggs)(load "Multiple toggles.lsp")))
  9. ; (setq ans (ah:toggs   '("A B C D" "A" "B" "C" "D")))
  10.  
  11. ; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
  12. ; (setq ans (ah:toggs '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")))
  13.  
  14. (defun mkv_lst ( / )
  15. (setq v_lst '())
  16. (setq x 1)
  17. (repeat (- (length ahbutlst) 1)
  18. (setq val (strcat "Tb" (rtos x 2 0)))
  19. (setq v_lst (cons (get_tile val) v_lst))
  20. (setq x (+ x 1))
  21. )
  22. )
  23.  
  24. (defun AH:Toggs (ahbutlst / fo fname x  y keylst keynum v_lst)
  25.  
  26. (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
  27. (write-line  "AHtoggles : dialog        {" fo)
  28. (write-line  (strcat "  label =" (chr 34) (nth 0 ahbutlst) (chr 34) " ;" )fo)
  29. (write-line "   : column        {" fo)
  30. (setq x 1)
  31. (repeat (- (length ahbutlst) 1)
  32. (write-line "   : toggle        {" fo)
  33. (write-line "alignment = centered ;"  fo)
  34. (write-line  (strcat "key = "  (chr 34) "Tb" (rtos x 2 0)  (chr 34) ";") fo)
  35. (write-line  (strcat "label = " (chr 34) (nth x  ahbutlst) (chr 34) ";") fo)
  36. (write-line "   }" fo)
  37. (write-line "spacer_1 ;" fo)
  38. (setq x (+ x 1))
  39. )
  40. (write-line "spacer_1 ;" fo)
  41. (write-line "   ok_cancel;" fo)
  42. (write-line "   }" fo)
  43. (write-line "   }" fo)
  44. (close fo)
  45.  
  46. (setq dcl_id (load_dialog fname))
  47. (if (not (new_dialog "AHtoggles" dcl_id) )
  48. )
  49.  
  50.  
  51. (setq y 0)
  52. (repeat (- (length ahbutlst) 1)
  53.     (setq keynum (strcat "Tb" (rtos (setq y (+ Y 1)) 2 0)))
  54.     (set_tile keynum "1")
  55.     (mode_tile keynum 3)
  56. )
  57.  
  58.  
  59.  
  60. (action_tile "accept" "(mkv_lst)(done_dialog)")
  61.  
  62. (action_tile "cancel" "(done_dialog)")
  63. (unload_dialog dcl_id)
  64. (princ v_lst)
  65. )
  66.  
  67.  


Thanks

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #8 on: October 20, 2019, 08:45:47 PM »
Sorry my fault forgot it returns strings not numbers.

Code: [Select]
(if (= (nth 0 ans) "1") (c:LinkLayerBlock )) ;  Blocks
(if (= (nth 1 ans) "1") (c:DLDL)) ;dimension
(if (= (nth 2 ans) "1") (c:DLHATCH)) ;hatch
(if (= (nth 3 ans) "1") (c:LinkLayerImage)) ;Images
(if (= (nth 4 ans) "1") (c:LV)) ;Viewports

« Last Edit: October 20, 2019, 08:50:08 PM by BIGAL »
A man who never made a mistake never made anything

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #9 on: October 21, 2019, 03:03:49 AM »
I try this . Load the menu but do nothing (don't  change the layers )

Code: [Select]
; Multi toggle Dialog box for multi choice
; By Alan H Oct 2019

; Example code
; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
; (setq ans (ah:toggs   '("Yes or No" "Yes" "No")))

; (if (not AH:Toggs)(load "Multiple toggles.lsp")))
; (setq ans (ah:toggs   '("A B C D" "A" "B" "C" "D")))

; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
; (setq ans (ah:toggs '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")))



(defun c:test ()

(defun mkv_lst ( / )
(setq v_lst '())
(setq x 1)
(repeat (- (length ahbutlst) 1)
(setq val (strcat "Tb" (rtos x 2 0)))
(setq v_lst (cons (get_tile val) v_lst))
(setq x (+ x 1))
)
)

(vl-load-com)
(defun AH:Toggs (ahbutlst / fo fname x  y keylst keynum v_lst)

(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line  "AHtoggles : dialog {" fo)
(write-line  (strcat " label =" (chr 34) (nth 0 ahbutlst) (chr 34) " ;" )fo)
(write-line " : column {" fo)
(setq x 1)
(repeat (- (length ahbutlst) 1)
(write-line " : toggle {" fo)
(write-line "alignment = centered ;"  fo)
(write-line  (strcat "key = "  (chr 34) "Tb" (rtos x 2 0)  (chr 34) ";") fo)
(write-line  (strcat "label = " (chr 34) (nth x  ahbutlst) (chr 34) ";") fo)
(write-line " }" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 1))
)
(write-line "spacer_1 ;" fo)
(write-line " ok_cancel;" fo)
(write-line " }" fo)
(write-line " }" fo)
(close fo)

(setq dcl_id (load_dialog fname))
(if (not (new_dialog "AHtoggles" dcl_id) )
(exit)
)


(setq y 0)
(repeat (- (length ahbutlst) 1)
    (setq keynum (strcat "Tb" (rtos (setq y (+ Y 1)) 2 0)))
    (set_tile keynum "1")
    (mode_tile keynum 3)
)



(action_tile "accept" "(mkv_lst)(done_dialog)")

(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete fname)
(princ v_lst)
)

(if (= (nth 0 ans) "1") (c:LinkLayerBlock )) ;  Blocks
(if (= (nth 1 ans) "1") (c:DLDL)) ;dimension
(if (= (nth 2 ans) "1") (c:DLHATCH)) ;hatch
(if (= (nth 3 ans) "1") (c:LinkLayerImage)) ;Images
(if (= (nth 4 ans) "1") (c:LV)) ;Viewports
)



BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #10 on: October 21, 2019, 08:31:37 PM »
What happens when you paste these 2 lines to the command line. Does the dialogue appear ?

(if (not AH:Toggs)(load "Multiple toggles.lsp")))
(setq ans (ah:toggs   '("Tick off/on " "Blocks" "Dimension" "Hatch" "Images" "Viewports")))

You should see something like (1 0 1 0)("1" "0" "1" '0") appear on command line if you untick then click Ok
A man who never made a mistake never made anything

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #11 on: October 22, 2019, 06:12:04 AM »
i confused now. Can you fix the code? I dont know what to do

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #12 on: October 23, 2019, 06:05:07 AM »
any iidea ?


Thanks

pedroantonio

  • Guest
Re: Link DCL with lisp
« Reply #13 on: October 23, 2019, 12:24:52 PM »
is it possible to use a dcl file and not another lisp to do this?

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: Link DCL with lisp
« Reply #14 on: October 24, 2019, 10:48:43 PM »
Ok start again.

Double checked again and the (not line has a extra ) you should have been getting a error message  "error : extra right parenthesis on input" always post error message helps to fix. My Bad not removed during testing.

You may want to change the (load "Multiple toggles.lsp")) to a full path like (load "c:\\myfiles\\lisp\\Multiple toggles.lsp")) for where you saved the Multiple toggles lisp. That's why I asked that (if (not AH:Toggs)(load "Multiple toggles.lsp")) was working.

This code should work I have not tested your code. But fixed the object does not exists in DIMS and Hatch.
Code: [Select]
; for blocks

(defun c:LinkLayerBlock ( / enx idx lay map sel )
    (setq
        map
       '(
;points

            ("KORYFES" . "ΑΞΟΝΟΔΙΑΣΤΑΥΡΩΣΗ")
            ("KOROT" . "ΚΟΡΥΦΗ ΟΤ")
            ("KOKAEK" . "ΣΗΜΕΙΟ ΚΑΕΚ")
            ("odsta" . "ΟΔΕΥΣΗ")
            ("odtrig" . "ΟΔΕΥΣΗ")
            ("REPERS" . "REPERS")
            ("station" . "ΣΤΑΣΗ")
            ("point" . "ΤΑΧΥΜΕΤΡΙΚΑ")
            ("trigonom" . "ΤΡΙΓΩΝΟΜΕΤΡΙΚΑ")
            ("MES" . "MES")
            ("Podi" . "ΠΟΔΙ")
            ("Fridi" . "φΡΥΔΙ")
            ("Ypsom" . "ΤΥΧΑΙΟ_ΥΨΟΜΕΤΡΟ")
            ("Dexia" . "ΔΕΞΙΑ")
            ("Aristera" . "ΑΡΙΣΤΕΡΑ")
            ("Dianomi" . "ΔΙΑΝΟΜΗ")
           
;trees

            ("tree1" . "ΔΕΝΤΡΟ")
            ("tree2" . "ΔΕΝΤΡΟ")
            ("tree3" . "ΔΕΝΤΡΟ")
            ("tree4" . "ΔΕΝΤΡΟ")
            ("tree5" . "ΔΕΝΤΡΟ")
            ("tree6" . "ΚΥΠΑΡΙΣΣΙ")
            ("tree7" . "ΚΥΠΑΡΙΣΣΙ")
            ("tree8" . "ΦΟΙΝΙΚΑΣ")
            ("tree9" . "ΦΟΙΝΙΚΑΣ")
            ("tree10" . "ΕΛΑΤΟ")
            ("tree11" . "ΑΜΠΕΛΙ")
            ("tree12" . "ΕΛΙΑ")
            ("tree13" . "ΕΣΠΕΡΙΔΟΕΙΔΗ")

;symbols

            ("ARID1" . "ΑΡΙΘ. ΙΔΙΟΚΤΗΣΙΑΣ")
            ("AROT1" . "Ο.Τ")
            ("velos" . "ΒΕΛΟΣ")
            ("dvelos" . "ΔΙΠΛΟ ΒΕΛΟΣ")
            ("NORTH" . "ΒΟΡΡΑΣ")
            ("vrisi" . "ΒΡΥΣΗ")
            ("vana" . "ΒΑΝΑ")
            ("DEH1" . "ΔΕΗ")
            ("Eikonastasi" . "ΕΙΚΟΝΟΣΤΑΣΙ")
            ("kamera" . "ΚΑΜΕΡΑ")
            ("MPASKETA" . "ΜΠΑΣΚΕΤΑ")
            ("OTE1" . "ΟΤΕ")
            ("krounos" . "ΚΡΟΥΝΟΣ")
            ("stathmi" . "ΣΤΑΘΜΕΣ")
            ("stayros" . "ΣΤΑΥΡΟΣ")
            ("simaia" . "ΣΗΜΑΙΑ")
            ("THL1" . "ΤΗΛ. ΘΑΛΑΜΟΣ")
            ("fanari" . "ΦΑΝΑΡΙ ΚΥΚΛΟΦΟΡΙΑΣ")
            ("pinakida" . "ΠΙΝΑΚΙΔΑ - ΤΑΜΠΕΛΑ")
            ("shma1" . "ΣΗΜΑ_ΤΡΙΓ")
            ("shma2" . "ΣΗΜΑ_ΣΤΡΟΓ")
            ("shma3" . "ΣΗΜΑ_ΕΞΑΓ")
            ("shma4" . "ΣΗΜΑ_ΤΕΤΡ")
            ("PETRA1" . "ΠΕΤΡΑ")
            ("PETRA2" . "ΠΕΤΡΑ")
            ("PETRA3" . "ΠΕΤΡΑ")
            ("PETRA4" . "ΠΕΤΡΑ")
            ("FANMONO" . "ΦΑΝΑΡΑΡΑΚΙ ΜΟΝΟ")
            ("FANDIPLO" . "ΦΑΝΑΡΑΡΑΚΙ ΔΙΠΛΟ")
            ("FANTRIPLO" . "ΦΑΝΑΡΑΡΑΚΙ ΤΡΙΠΛΟ")
            ("FANMONO2" . "ΣΤΥΛΟΣ ΦΩΤΙΣΜΟΥ ΜΟΝΟΣ")
            ("fos1" . "ΦΩΤΙΣΜΟΣ ΟΔΟΥ") 

;Annotation points

            ("AnnotKORYFES" . "_ΑΞΟΝΟΔΙΑΣΤΑΥΡΩΣΗ")
            ("AnnotKOROT" . "_ΚΟΡΥΦΗ ΟΤ")
            ("AnnotKOKAEK" . "_ΣΗΜΕΙΟ ΚΑΕΚ")
            ("Annotodsta" . "_ΟΔΕΥΣΗ")
            ("Annotodtrig" . "_ΟΔΕΥΣΗ")
            ("AnnotREPERS" . "_REPERS")
            ("Annotstation" . "_ΣΤΑΣΗ")
            ("Annotpoint" . "_ΤΑΧΥΜΕΤΡΙΚΑ")
            ("Annottrigonom" . "_ΤΡΙΓΩΝΟΜΕΤΡΙΚΑ")
            ("AnnotMes" . "_MES")
            ("AnnotPodi" . "_ΠΟΔΙ")
            ("AnnotFridi" . "_φΡΥΔΙ")
            ("AnnotYpsom" . "_ΤΥΧΑΙΟ_ΥΨΟΜΕΤΡΟ")
            ("AnnotDexia" . "_ΔΕΞΙΑ")
            ("AnnotAristera" . "_ΑΡΙΣΤΕΡΑ")
            ("AnnotDianomi" . "_ΔΙΑΝΟΜΗ")


;Annotation trees

            ("annottree1" . "_ΔΕΝΤΡΟ")
            ("annottree2" . "_ΔΕΝΤΡΟ")
            ("annottree3" . "_ΔΕΝΤΡΟ")
            ("annottree4" . "_ΔΕΝΤΡΟ")
            ("annottree5" . "_ΔΕΝΤΡΟ")
            ("annottree6" . "_ΚΥΠΑΡΙΣΣΙ")
            ("annottree7" . "_ΚΥΠΑΡΙΣΣΙ")
            ("annottree8" . "_ΦΟΙΝΙΚΑΣ")
            ("annottree9" . "_ΦΟΙΝΙΚΑΣ")
            ("annottree10" . "_ΕΛΑΤΟ")
            ("annottree11" . "_ΑΜΠΕΛΙ")
            ("annottree12" . "_ΕΛΙΑ")
            ("annottree13" . "_ΕΣΠΕΡΙΔΟΕΙΔΗ")

;Annotation symbols

            ("AnnotARID1" . "_ΑΡΙΘ. ΙΔΙΟΚΤΗΣΙΑΣ")
            ("AnnotAROT1" . "_Ο.Τ")
            ("Annotvelos" . "_ΒΕΛΟΣ")
            ("Annotdvelos" . "_ΔΙΠΛΟ ΒΕΛΟΣ")
            ("AnnotNORTH" . "_ΒΟΡΡΑΣ")
            ("Annotvrisi" . "_ΒΡΥΣΗ")
            ("Annotvana" . "_ΒΑΝΑ")
            ("AnnotDEH1" . "_ΔΕΗ")
            ("AnnotEikonastasi" . "_ΕΙΚΟΝΟΣΤΑΣΙ")
            ("mscale" . "ΚΛΙΜΑΚΑ")
            ("Annotkamera" . "_ΚΑΜΕΡΑ")
            ("AnnotMPASKETA" . "_ΜΠΑΣΚΕΤΑ")
            ("raga" . "ΟΣΕ")
            ("AnnotOTE1" . "_ΟΤΕ")
            ("Annotkrounos" . "_ΚΡΟΥΝΟΣ")
            ("Annotstathmi" . "_ΣΤΑΘΜΕΣ")
            ("Annotstayros" . "_ΣΤΑΥΡΟΣ")
            ("Annotsimaia" . "_ΣΗΜΑΙΑ")
            ("AnnotTHL1" . "_ΤΗΛ. ΘΑΛΑΜΟΣ")
            ("Annotfanari" . "_ΦΑΝΑΡΙ ΚΥΚΛΟΦΟΡΙΑΣ")
            ("ARI_KAN" . "Κάνναβος_Συντ")
            ("grtick" . "Κάνναβος_Σταυρός")
            ("Annotpinakida" . "_ΠΙΝΑΚΙΔΑ - ΤΑΜΠΕΛΑ")
            ("Annotshma1" . "_ΣΗΜΑ_ΤΡΙΓ")
            ("Annotshma2" . "_ΣΗΜΑ_ΣΤΡΟΓ")
            ("Annotshma3" . "_ΣΗΜΑ_ΕΞΑΓ")
            ("Annotshma4" . "_ΣΗΜΑ_ΤΕΤΡ")
            ("AnnotPETRA1" . "_ΠΕΤΡΑ")
            ("AnnotPETRA2" . "_ΠΕΤΡΑ")
            ("AnnotPETRA3" . "_ΠΕΤΡΑ")
            ("AnnotPETRA4" . "_ΠΕΤΡΑ")
            ("AnnotFANMONO" . "_ΦΑΝΑΡΑΡΑΚΙ ΜΟΝΟ")
            ("AnnotFANDIPLO" . "_ΦΑΝΑΡΑΡΑΚΙ ΔΙΠΛΟ")
            ("AnnotFANTRIPLO" . "_ΦΑΝΑΡΑΡΑΚΙ ΤΡΙΠΛΟ")
            ("AnnotFANMONO2" . "_ΣΤΥΛΟΣ ΦΩΤΙΣΜΟΥ ΜΟΝΟΣ")
            ("Annotfos1" . "_ΦΩΤΙΣΜΟΣ ΟΔΟΥ")         

        )
        map (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) map)
    )
    (if
        (setq sel
            (ssget "_X"
                (append
                   '(
                        ( 0 . "INSERT")
                        (-4 . "<OR")
                        ( 2 . "`*U*")
                    )
                    (mapcar '(lambda ( x ) (cons 2 (car x))) map)
                   '(
                        (-4 . "OR>")
                    )
                )
            )
        )
        (repeat (setq idx (sslength sel))
            (setq enx (entget (ssname sel (setq idx (1- idx)))))
            (if (setq lay (cdr (assoc (strcase (LM:name->effectivename (cdr (assoc 2 enx)))) map)))
                (entmod (subst (cons 8 lay) (assoc 8 enx) enx))
            )
        )
    )
    (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("AcDbBlockRepBTag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)

(princ)


;;;;;;;;;; for images

(vl-load-com)

(defun c:LinkLayerImage (/ *error* acDoc layerName oLayer ss)

  (defun *error* (msg)
    (if ss
      (vla-delete ss)
    )
    (if acDoc
      (progn
        (vla-endundomark acDoc)
        (vla-regen acDoc acallviewports)
      )
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (if (ssget "_X" '((0 . "IMAGE") (8 . "~Image")))
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
      )

      ;; get or create layer
      (setq oLayer
             (vla-add (vla-get-layers acDoc) (setq layerName "Image"))
      )

      ;; set image layer
      (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
        (vla-put-layer x layerName)
      )

      (setvar 'clayer "Line1")
    )
)

  (*error* nil)
)


;;;;;;;;;; for DIMENSIONS

    (defun c:DLDL (/ sel1 CLAYER )
;Switch from Layout Tab To Model Tab before stating LISP
    (command "_.Tilemode" 1) ; To model space
   (if  (setq sel1 (ssget "X" '((0 . "DIMENSION")))) ; SELECT ALL DIMENSION
(progn
    (setq OLDLAYER (getvar "CLAYER")) ;GET CURRENT LAYER
    (COMMAND "_layer" "_m" "DIM" "_c" "10""" "") ;CREATE NEW LAYER
    (setvar "CLAYER" OLDLAYER) ; SET ACTIVE LAYER TO PREVIOUS
    (command "CHPROP" sel1 "" ; CHANGE DIMENSION LAYER TO NEW LAYER
    "LAYER" "DIM"
    "")
   (command "_.Tilemode" 0) ;And back to last current layout
)
(alert "No Dims")
)
    );END PROGRAM


;;;;;;;;;;for HATCH

    (defun c:DLHATCH (/ sel1 CLAYER )
;Switch from Layout Tab To Model Tab before stating LISP
    (command "_.Tilemode" 1) ; To model space
   (if  (setq sel1 (ssget "X" '((0 . "HATCH")))) ; SELECT ALL HATCH
(progn
    (setq OLDLAYER (getvar "CLAYER")) ;GET CURRENT LAYER
    (COMMAND "_layer" "_m" "HATCH" "_c" "155" "" "_lw" "0.18" "" "") ;CREATE NEW LAYER
    (setvar "CLAYER" OLDLAYER) ; SET ACTIVE LAYER TO PREVIOUS
    (command "CHPROP" sel1 "" ; CHANGE HATCH LAYER TO NEW LAYER
    "LAYER" "HATCH"
    "")
   (command "_.Tilemode" 0) ;And back to last current layout

    (setq sel1 (ssget "X" '((0 . "HATCH")))) ; SELECT ALL HATCH
    (setq OLDLAYER (getvar "CLAYER")) ;GET CURRENT LAYER
    (COMMAND "_layer" "_m" "HATCH" "_c" "155" "" "_lw" "0.18" "" "") ;CREATE NEW LAYER
    (setvar "CLAYER" OLDLAYER) ; SET ACTIVE LAYER TO PREVIOUS
    (command "CHPROP" sel1 "" ; CHANGE HATCH LAYER TO NEW LAYER
    "LAYER" "HATCH"
    "")
)
(alert "no Hatch")
)
    );END PROGRAM


;;;;;;;;;; for VIEPORTS

    (defun c:LV ( / idx lay obj sel )
       
        (setq lay "VIEWPORT") ;; Viewport Layer
     
        (if (setq sel (ssget "_X" (list '(0 . "VIEWPORT") (cons 8 (strcat "~" lay)))))
            (progn
                (if (not (tblsearch "layer" lay))
                    (entmake
                        (list
                           '(000 . "LAYER")
                           '(100 . "AcDbSymbolTableRecord")
                           '(100 . "AcDbLayerTableRecord")
                           '(070 . 0)
                            (cons 2 lay)
                        )
                    )
                )
                (repeat (setq idx (sslength sel))
                    (setq idx (1- idx)
                          obj (vlax-ename->vla-object (ssname sel idx))
                    )
                    (if (vlax-write-enabled-p obj) (vla-put-layer obj lay))
                )
            )
        )
        (princ)
    )
    (vl-load-com) (princ)

(if (not AH:Toggs)(load "Multiple toggles.lsp"))
(setq ans (ah:toggs   '("Tick off/on " "Blocks" "Dimension" "Hatch" "Images" "Viewports")))

(if (= (nth 0 ans) "1") (c:LinkLayerBlock )) ;  Blocks
(if (= (nth 1 ans) "1") (c:DLDL)) ;dimension
(if (= (nth 2 ans) "1") (c:DLHATCH)) ;hatch
(if (= (nth 3 ans) "1") (c:LinkLayerImage)) ;Images
(if (= (nth 4 ans) "1") (c:LV)) ;Viewports

« Last Edit: October 24, 2019, 11:20:13 PM by BIGAL »
A man who never made a mistake never made anything