Jump to content

Help with a lisp code

Guest

By Guest
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Guest

Guest

Posted
Posted

Hi. I am trying to write a code to select automatcaly all polylines and texts and insert them  to the correct layers but i have a syntax error in the code and i can not find it

  

(defun c:LinkLayerDas (/ *error* acDoc layerName oLayer ss) 
(TEXTPAGE)
 (princ "\n")(princ "\n")(princ "\n")
(progn
	   (initget "1 2 3")
	   (setq
	     l
	      (cond
		((getkword
		   "\nSelect:
	               1. Layer Polyline 
	               2. Layer Text KATHGORDX
	               3. Layer Text KATHGORAL1
	               "
	  )
	 )
	 ("1")
       )
    )

;;;;;;;;; for Polylines only
    (if	(eq l "1")
      (COMMAND "_layer" "_m" "KYROSI" "_c" "101" "" "")
      (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 . "lwpolyline") (8 . "~lwpolyline")))
	(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 "KYROSI"))
	  )

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

	  (setvar 'clayer "Line1")
	)
      )

      (*error* nil)
    )

;;;;;;;;; for Text KATHGORDX

    (if	(eq l "2")

      (COMMAND "_layer" "_m" "KATHGORDX" "_c" "10" "" "")
      (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 . "text") (8 . "~text")))
	(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 "KATHGORDX")
		 )
	  )

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

	  (setvar 'clayer "Line1")
	)
      )

    )

;;;;;;;;; for Text KATHGORAL1

    (if	(eq l "3")
      (COMMAND "_layer" "_m" "KATHGORAL1" "_c" "142" "" "")
      (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 . "text") (8 . "~text")))
	(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 "KATHGORAL1")
		 )
	  )

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

	  (setvar 'clayer "Line1")
	)
      )

    )

  )

)

If it possible i want a change in the code to work like ths because is faster

  

(progn
	   (initget "1 2")
	   (setq
	     l
	      (cond
		((getkword
		   "\nSelect:
	               1. Layer Polyline and Layer Text KATHGORDX
	               2. Layer Text KATHGORAL1
	               "
	  )
	 )
	 ("1")
       )
    )

 

 

Thanks

 

 

 

Link to comment
Share on other sites
dlanorh Mentor

dlanorh

Posted
Posted (edited)

What are you trying to do here?

  

(ssget "_X" '((0 . "lwpolyline") (8 . "~lwpolyline")))

and

(ssget "_X" '((0 . "text") (8 . "~text")))

 

specifically the 8 group codes

 

  

(setq l (cond ( (getkword "\nSelect: 1. Layer Polyline and Layer Text KATHGORDX 2. Layer Text KATHGORAL1" ))
	 		  ("1")
        )
)

Which layer do the Polylines go into if you choose 1.?  KATHGORDX or KYROSI ? and is this to select Text and LWPolylines?

 

What happens to Polylines when you choose 2 or is this just supposed to select Text?

 

 

Edited by dlanorh
Link to comment
Share on other sites
Guest

Guest

Posted
Posted

Ηι dlanorh.

 

I have some dxf files with polylines and texts all in one layer. In some of them the polylines are the same but the texts change. So i want a lisp to

1) select all polylines  and texts and put  them in layers  "KYROSI " and "KATHGORDX"

2) And when i have to change layer only to the text  select texts and put them in the layer  " and "KATHGORAL1"

 

Thanks

Link to comment
Share on other sites
dlanorh Mentor

dlanorh

Posted
Posted
1 hour ago, prodromosm said:

Ηι dlanorh.

 

I have some dxf files with polylines and texts all in one layer. In some of them the polylines are the same but the texts change.

 

 

OK. What is the name of the layer that contains the polylines and texts?

Link to comment
Share on other sites
Guest

Guest

Posted
Posted

Is not the same ,thats why i want to select all the polylines and all the texts and move them to new layers

 all polylines  ----->  "KYROSI

 all text --- >"KATHGORDX"

Second option only text  --- > "KATHGORAL1"

Link to comment
Share on other sites
dlanorh Mentor

dlanorh

Posted
Posted

Try this. It utilises the dynamic prompt and dynamic mode for the getkword part.

  

(defun c:LinkLayerDas (/ *error* sv_lst sv_vals c_doc c_lyrs tmp ss flg obj) 

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt 'clayer)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (cond ( (not (tblsearch "layer" "KYROSI")) (setq tmp (vla-add c_lyrs "KYROSI")) (vlax-put-property tmp 'color 101)))
  (cond ( (not (tblsearch "layer" "KATHGORDX")) (setq tmp (vla-add c_lyrs "KATHGORDX")) (vlax-put-property tmp 'color 10)))
  (cond ( (not (tblsearch "layer" "KATHGORAL1")) (setq tmp (vla-add c_lyrs "KATHGORAL1")) (vlax-put-property tmp 'color 142)))
  
  (initget "1 2")
  (setq tmp (cond ( (getkword "\nSelect Text Layer 1 KATHGORDX 2 KATHGORAL1 [1/2] <1> : ")) ("1")))

  (cond ( (eq tmp "1")
          (setq ss (ssget "_X" '((0 . "LWPOLYLINE,TEXT")))
                flg nil
          );end_setq
        )
        ( (eq tmp "2")
          (setq ss (ssget "_X" '((0 . "TEXT")))
                flg T
          );end_setq
        )
  );end_cond
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (cond ( (not flg)
                    (if (vlax-property-available-p obj 'elevation) (vlax-put-property obj 'layer "KYROSI") (vlax-put-property obj 'layer "KATHGORDX"))
                    
                  )
                  (t (vlax-put-property obj 'layer "KATHGORAL1"))
            );end_cond
          );end_repeat
        )
  );end_cond
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

 

Link to comment
Share on other sites
Guest

Guest

Posted
Posted

There is a problem in this code. When the layer exist in the drawing  his color didnt change. Is it possible to forse them to change the lcolor in an exist layer ?

  

(defun c:LinkLayerDas (/ *error* sv_lst sv_vals c_doc c_lyrs tmp ss
flg obj) 

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL))))
(vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt 'clayer)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL))))
(vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (cond ( (not (tblsearch "layer" "KYROSI")) (setq tmp (vla-add
c_lyrs "KYROSI")) (vlax-put-property tmp 'color 101)))
  (cond ( (not (tblsearch "layer" "KATHGORDX")) (setq tmp (vla-add
c_lyrs "KATHGORDX")) (vlax-put-property tmp 'color 10)))
  (cond ( (not (tblsearch "layer" "KATHGORAL1")) (setq tmp (vla-add
c_lyrs "KATHGORAL1")) (vlax-put-property tmp 'color 142)))
 
 (TEXTPAGE)
  (initget "1 2")
  (setq tmp (cond ( (getkword  "\n Select:
	               1. Layer Polyline KYROSI and Layer Text KATHGORDX
	               2. Layer Polyline KYROSI and Layer Text KATHGORAL1
	               [1/2] <1> : ")) ("1")))

  (cond ( (eq tmp "1")
          (setq ss (ssget "_X" '((0 . "LWPOLYLINE,TEXT")))
                flg nil
          );end_setq
        )
        ( (eq tmp "2")
          (setq ss (ssget "_X" '((0 . "TEXT")))
                flg T
          );end_setq
        )
  );end_cond
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq
cnt (1- cnt)))))
            (cond ( (not flg)
                    (if (vlax-property-available-p obj 'elevation)
(vlax-put-property obj 'layer "KYROSI") (vlax-put-property obj
'layer "KATHGORDX"))
                    
                  )
                  (t (vlax-put-property obj 'layer "KATHGORAL1"))
            );end_cond
          );end_repeat
        )
  );end_cond
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL))))
(vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

Thanks

Link to comment
Share on other sites
dlanorh Mentor

dlanorh

Posted
Posted

It's not a problem in the code, I assumed if the layer was already there it would have the correct colour. Easy to fix, Try this:

  

(defun c:LinkLayerDas (/ *error* sv_lst sv_vals c_doc c_lyrs tmp ss flg obj) 

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt 'clayer)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (cond ( (not (tblsearch "layer" "KYROSI")) (setq tmp (vla-add c_lyrs "KYROSI")) (vlax-put-property tmp 'color 101))(t (vlax-put-property (vla-item c_lyrs "KYROSI") 'color 101)))
  (cond ( (not (tblsearch "layer" "KATHGORDX")) (setq tmp (vla-add c_lyrs "KATHGORDX")) (vlax-put-property tmp 'color 10))(t (vlax-put-property (vla-item c_lyrs "KATHGORDX") 'color 10)))
  (cond ( (not (tblsearch "layer" "KATHGORAL1")) (setq tmp (vla-add c_lyrs "KATHGORAL1")) (vlax-put-property tmp 'color 142))(t (vlax-put-property (vla-item c_lyrs "KATHGORAL1") 'color 142)))
  
  (initget "1 2")
  (setq tmp (cond ( (getkword "\nSelect Text Layer 1 KATHGORDX 2 KATHGORAL1 [1/2] <1> : ")) ("1")))

  (cond ( (eq tmp "1")
          (setq ss (ssget "_X" '((0 . "LWPOLYLINE,TEXT")))
                flg nil
          );end_setq
        )
        ( (eq tmp "2")
          (setq ss (ssget "_X" '((0 . "TEXT")))
                flg T
          );end_setq
        )
  );end_cond
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (cond ( (not flg)
                    (if (vlax-property-available-p obj 'elevation) (vlax-put-property obj 'layer "KYROSI") (vlax-put-property obj 'layer "KATHGORDX"))
                    
                  )
                  (t (vlax-put-property obj 'layer "KATHGORAL1"))
            );end_cond
          );end_repeat
        )
  );end_cond
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

 

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

A variation on the initget

  


(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))
(setq ans (ah:butts but "h"  '("KATHGORDX or KATHGORAL1" "KATHGORDX" "KATHGORAL1"))) ; ans holds the button picked value
(if (= ans "KATHGORDX")
(setq ss (ssget "_X" '((0 . "LWPOLYLINE,TEXT")))
(setq ss (ssget "_X" '((0 . "TEXT")))
)

image.png.4d57d0cb937f12424a1cd99d0ef593d6.png

Multi radio buttons.lsp

Link to comment
Share on other sites
Guest

Guest

Posted
Posted

Hi bigal . I can not understan how this variation works .I replace  this

  

  (setq tmp (cond ( (getkword "\nSelect Text Layer 1 KATHGORDX 2 KATHGORAL1 [1/2] <1> : ")) ("1")))

  (cond ( (eq tmp "1")
          (setq ss (ssget "_X" '((0 . "LWPOLYLINE,TEXT")))
                flg nil
          );end_setq
        )
        ( (eq tmp "2")
          (setq ss (ssget "_X" '((0 . "TEXT")))
                flg T
          );end_setq
        )

with your code and ii paste the Multi radio buttons at the end of the lisp but is not working.

 

Thanks

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Try this but Multi radio buttons.lsp must be in the support search path so it auto loads.

  


(defun c:LinkLayerDas (/ *error* sv_lst sv_vals c_doc c_lyrs tmp ss flg obj) 

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
    (princ)
  );_end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode 'dynmode 'dynprompt 'clayer)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0 3 1))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (cond ( (not (tblsearch "layer" "KYROSI")) (setq tmp (vla-add c_lyrs "KYROSI")) (vlax-put-property tmp 'color 101))(t (vlax-put-property (vla-item c_lyrs "KYROSI") 'color 101)))
  (cond ( (not (tblsearch "layer" "KATHGORDX")) (setq tmp (vla-add c_lyrs "KATHGORDX")) (vlax-put-property tmp 'color 10))(t (vlax-put-property (vla-item c_lyrs "KATHGORDX") 'color 10)))
  (cond ( (not (tblsearch "layer" "KATHGORAL1")) (setq tmp (vla-add c_lyrs "KATHGORAL1")) (vlax-put-property tmp 'color 142))(t (vlax-put-property (vla-item c_lyrs "KATHGORAL1") 'color 142)))
  
  (if (not AH:Butts)(load "Multi Radio buttons.lsp"))
  (setq ans (ah:butts 1 "h"  '("KATHGORDX or KATHGORAL1" "KATHGORDX" "KATHGORAL1"))) ; ans holds the button picked value
  (if (= ans "KATHGORDX")
  (setq ss (ssget "_X" '((0 . "LWPOLYLINE,TEXT")))
  (setq ss (ssget "_X" '((0 . "TEXT")))
  )

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (cond ( (not flg)
                    (if (vlax-property-available-p obj 'elevation) (vlax-put-property obj 'layer "KYROSI") (vlax-put-property obj 'layer "KATHGORDX"))
                    
                  )
                  (t (vlax-put-property obj 'layer "KATHGORAL1"))
            );end_cond
          );end_repeat
        )
  );end_cond
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...