Jump to content

just for understanding

Ajmal

By Ajmal
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Ajmal Enthusiast

Ajmal

Posted
Posted

I just started to learn lisp and mostly am copy-pasting and checking one by one.  I do not have a programing background or anything like that so please help me to understand.

 

Last time I make something I need. It was successfully I finished.

Please tell me if there is any mistake or your suggestion

And if you can put your way for the same task that may be I can understand very well on new things

  

(while
    (progn
      (setq entldr nil enttxt nil)
    (if
      (setq sel(LM:ssget "\nSelect Text & leader: "
			 (list "_:L"
			       (list
				 '(000 . "TEXT,MTEXT,LEADER")
				 (if (= 1 (getvar 'cvport))
				   (cons 410 (getvar 'ctab))
				   '(410 . "Model")
				   )
				 )
			       )
			 )
	    )
      (progn
	(cond
	  (	(< 2 (sslength sel))
	   	(princ "\nThe selection have more than 2 object")
	   )
	  (	(= 1 (sslength sel))
	   	(progn
		  (cond
		    (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"TEXT,MTEXT"))
		     	(princ "\nThe selection don't have text")
		     )
		    (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"LEADER"))
		     	(princ "\nThe selection don't have leader")
		     ))
		  )
	   )
	  (	(= 2 (sslength sel))
	   	(progn
		  (repeat (setq i (sslength sel))
		    (or (not (entget (setq ent (ssname sel (setq i (1- i))))))
		    (if
		      (not (wcmatch(cdr (assoc 0(entget ent)))"TEXT,MTEXT"))
		      (setq entldr ent)
		      (setq enttxt ent)))
		    )
		  (cond
		    (	(= entldr nil)
		     	(princ "\nThe selection have multiple text")
		     )
		    (	(= enttxt nil)
	    		(princ "\nThe selection have multiple leader")
		     )
		    )
		  )
	   )
	  )
	)
      )
      )
  )

 

  • Like 1
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)

Maybe you could explain a little more on what your trying to do. but here are my suggestions so far.

 

while & cond do not need progn to run multiple lines of code.

you aren't defining anything with while so i removed it. think of it as loop while conditions are met.

iv stoped using (ssname sel (setq i (1- i)) to step thorougth the selection sets and use foreach with ssnamex

 

also defined local variables so

1. they arn't global variables

2. they are cleared or nil after the lisp runs.

 

use (princ) at the end or you will return the last thing outputted again.

The selection have more than 2 object"\nThe selection have more than 2 object"

 

Think of all possibility that you can run into when using conditions.

your ((= 2 (sslength sel)) would trigger if you had two text or a text and a leader.

  

(defun C:foo (/ ldr txt sel)
  (setq ldr 0 txt 0) ;better tracking of selection with integers
  (if (setq sel (ssget "_:L" '((0 . "TEXT,MTEXT,LEADER") (cons 410 (getvar 'ctab)))))
    (progn
      (cond
        ((< 2 (sslength sel))
            (prompt (strcat "\nTheir are " (itoa (sslength sel)) " entitys in this selection")) 
        )   ;more then 2 is vage use the actual number
        ((= 1 (sslength sel))
          (cond
            ((not (wcmatch (cdr (assoc 0 (entget (ssname sel 0)))) "TEXT,MTEXT"))
                  (princ "\nThe selection don't have text")
            )
            ((not (wcmatch (cdr (assoc 0 (entget (ssname sel 0)))) "LEADER"))
                  (princ "\nThe selection don't have leader")
            )
          )
        )
        ((= 2 (sslength sel))
          (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
            (if (wcmatch (cdr (assoc 0 (entget ent))) "TEXT,MTEXT")
             (setq txt (1+ txt)) 
             (setq ldr (1+ ldr))
            )
          )
          (cond
            ((= ldr 2) ;Both entitys have to be text for this to trigger. 
                (princ "\nThe selection have 2 text")
            )
            ((= txt 2) ;Both entitys have to be leaders for this to trigger. 
                (princ "\nThe selection have 2 leader")
            )
            ((= txt 1) (= ldr 1) 
                (princ "\nThe selection is 1 leader and 1 text")
            )
          )
        )
      )
    )
  )
  (prompt "\nNothing selected")
  (princ)
)

 

Edited by mhupp
Link to comment
Share on other sites
Ajmal Enthusiast

Ajmal

Posted
  • Author
Posted
7 hours ago, devitg said:

Hi Ajmal , please clear what is the SAME TASK  to do

 

 

 

My task is to make a selection set with 2 items, and extract that item and entget the item, but

Which means

                Ssget the item text and leader

                Check the selection set contain only 2 items from that should be only text and leader

                And from the selection set  extract the item end endget the item

Link to comment
Share on other sites
Ajmal Enthusiast

Ajmal

Posted
  • Author
Posted

Here is the correct task

 

I got this code from the forum. And I need to add something from me to be useful for me 

(defun rh:gbbw (obj / ll ur lst wt)
  (if (and obj (= (type obj) 'ENAME))  (setq obj (vlax-ename->vla-object obj)))
  (vlax-invoke-method obj 'getboundingbox 'll 'ur)
  (setq lst (mapcar 'vlax-safearray->list (list ll ur)) wt (mapcar '(lambda (x y) (- x y)) (cadr lst) (car lst)))
  wt
);end_defun

(defun rh:z22pi (ar) (cond ( (equal ar (* pi 2.0) 1.0e-10) 0.0) ( (< -1.0e-16 ar (* pi 2.0)) ar) (t (rh:z22pi (rem (+ ar (* pi 2)) (* pi 2))))))

(vl-load-com)

(defun c:let ( / sel ent el w obj nobj tang ipt lel lent lst lang a b ept)
  (while (setq sel (entsel "\nSelect Leader Text : "))
    (setq el (entget (setq ent (car sel))) w nil nobj nil)
    (cond ( (= (cdr (assoc 0 el)) "TEXT")
            (setq obj (vlax-ename->vla-object ent) tang (rh:z22pi (cdr (assoc 50 el))) ipt (cdr (assoc 10 el)))
            (if (not (zerop tang)) (vlax-put obj 'rotation 0))
            (setq w (rh:gbbw obj))
            (if (not (zerop tang)) (vlax-put obj 'rotation tang))
          )
          ( (= (cdr (assoc 0 el)) "MTEXT")
            (setq obj (vlax-ename->vla-object ent)
                  tang (rh:z22pi (cdr (assoc 50 el)))
                  nobj (vla-copy obj)
            );end_setq
            (vl-cmdf "explode" (vlax-vla-object->ename nobj) "")
            (setq el (entget (setq ent (entlast))) ipt (cdr (assoc 10 el)) nobj (vlax-ename->vla-object ent))
            (if (not (zerop tang)) (vlax-put nobj 'rotation 0))
            (setq w (rh:gbbw nobj))
            (vla-delete nobj)
          )
    );end_cond

    (cond (w
            (setq w (car w)
                  lel (entget (setq lent (car (entsel "\nSelect Leader : "))))
            );end_setq
            (cond ( (= (cdr (assoc 0 lel)) "LEADER")
                    (setq obj (vlax-ename->vla-object lent)
                          lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) lel))
                          lang (rh:z22pi (angle (setq a (nth (- (length lst) 2) lst)) (setq b (last lst))))
                    );end_setq
                    (if (equal lang tang 1.0e-4) (setq ept (polar ipt tang w)) (setq ept ipt))
                    (setq ept (inters a b ept (polar ept (+ tang (* pi 0.5)) 5.0) nil)
                          lst (reverse (cons ept (cdr (reverse lst))))
                    )
                    (vlax-put obj 'coordinates (apply 'append lst))
                  )
            );end_cond
          )
    );end_cond
  );end_while
  (princ)
);end_defun

 

And I had some issues and I try to solve and  I get the answer from the another topic

Here is the topic  

so it was successfully finished

 

 

Then I had a new idea think it not with only this topic. I need to understand more about the lisp so I created this topic. 

I have done what I need. but I need to understand the things is more clear. what I did is copy-paste and checking one by one.

  

(defun rh:gbbw (obj / ll ur lst wt)
  (if (and obj (= (type obj) 'ENAME))  (setq obj (vlax-ename->vla-object obj)))
  (vlax-invoke-method obj 'getboundingbox 'll 'ur)
  (setq lst (mapcar 'vlax-safearray->list (list ll ur)) wt (mapcar '(lambda (x y) (- x y)) (cadr lst) (car lst)))
  wt
)
(defun rh:z22pi (ar) (cond ( (equal ar (* pi 2.0) 1.0e-10) 0.0) ( (< -1.0e-16 ar (* pi 2.0)) ar) (t (rh:z22pi (rem (+ ar (* pi 2)) (* pi 2))))))
(vl-load-com)
(defun c:let(/ l sslgn sel i entldr enttxt)
  (while
    (progn
      (setq entldr nil enttxt nil)
    (if
      (setq sel(LM:ssget "\nSelect Text & leader: "
			 (list "_:L"
			       (list
				 '(000 . "TEXT,MTEXT,LEADER")
				 (if (= 1 (getvar 'cvport))
				   (cons 410 (getvar 'ctab))
				   '(410 . "Model")
				   )
				 )
			       )
			 )
	    )
      (progn
	(cond
	  (	(< 2 (sslength sel))
	   	(princ "\nThe selection have more than 2 object")
	   )
	  (	(= 1 (sslength sel))
	   	(progn
		  (cond
		    (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"TEXT,MTEXT"))
		     	(princ "\nThe selection don't have text")
		     )
		    (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"LEADER"))
		     	(princ "\nThe selection don't have leader")
		     ))
		  )
	   )
	  (	(= 2 (sslength sel))
	   	(progn
		  (repeat (setq i (sslength sel))
		    (or (not (entget (setq ent (ssname sel (setq i (1- i))))))
		    (if
		      (not (wcmatch(cdr (assoc 0(entget ent)))"TEXT,MTEXT"))
		      (setq entldr ent)
		      (setq enttxt ent)))
		    )
		  (cond
		    (	(= entldr nil)
		     	(princ "\nThe selection have multiple text")
		     )
		    (	(= enttxt nil)
	    		(princ "\nThe selection have multiple leader")
		     )
		    )
		  )
	   )
	  )))
      (setq el (entget enttxt) w nil nobj nil)
      (cond ( (= (cdr (assoc 0 el)) "TEXT")
            (setq obj (vlax-ename->vla-object enttxt) tang (rh:z22pi (cdr (assoc 50 el))) ipt (cdr (assoc 10 el)))
            (if (not (zerop tang)) (vlax-put obj 'rotation 0))
            (setq w (rh:gbbw obj))
            (if (not (zerop tang)) (vlax-put obj 'rotation tang))
          )
          ( (= (cdr (assoc 0 el)) "MTEXT")
            (setq obj (vlax-ename->vla-object enttxt)
                  tang (rh:z22pi (cdr (assoc 50 el)))
                  nobj (vla-copy obj)
		  ss   (ssadd)
            );end_setq
	   (setq en (entlast))
            (vl-cmdf "._explode" (vlax-vla-object->ename nobj))
            (setq el (entget (setq enttxt (entlast)))
		  ipt (cdr (assoc 10 el))
		  nobj (vlax-ename->vla-object enttxt))
            (if (not (zerop tang)) (vlax-put nobj 'rotation 0))
            (setq w (rh:gbbw nobj))
	   (while (setq en (entnext en))
              (if (not (wcmatch (cdr (assoc 0 (entget en))) "ATTRIB,VERTEX,SEQEND"))(ssadd en ss))
            )
            (repeat (setq ssi (sslength ss))
	      (or (not(entget (setq ssent (ssname ss (setq ssi (1- ssi)))))))
		  (vla-delete (vlax-ename->vla-object ssent))
		  )
	      )
	  )
    (cond (w
            (setq w (car w)
                  lel (entget entldr)
            );end_setq
            (cond ( (= (cdr (assoc 0 lel)) "LEADER")
                    (setq obj (vlax-ename->vla-object entldr)
                          lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) lel))
                          lang (rh:z22pi (angle (setq a (nth (- (length lst) 2) lst)) (setq b (last lst))))
                    );end_setq
                    (if (equal lang tang 1.0e-4) (setq ept (polar ipt tang w)) (setq ept ipt))
                    (setq ept (inters a b ept (polar ept (+ tang (* pi 0.5)) 5.0) nil)
                          lst (reverse (cons ept (cdr (reverse lst))))
                    )
                    (vlax-put obj 'coordinates (apply 'append lst))
                  )
            );end_cond
          )
    )
      )
    )
  (princ)
  )
		    


;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)

 

 

I need to know not only to clear the topic. what are my mistakes and what I should do or not 

Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)
3 hours ago, Ajmal said:

I need to understand the things is more clear.

 

these websites are good for tutorials to help you understand whats going on.

https://www.afralisp.net/autolisp/

http://www.lee-mac.com/tutorials.html

https://www.cadtutor.net/tutorials/autolisp/quick-start.php

they have step by step instructions with clear examples.

 

also doesn't hurt to have a lisp dictionary for things you run across that might not understand whats its doing.

https://documentation.help/AutoLISP-Functions/WSfacf1429558a55de1a7524c1004e616f8b-5913.htm

Edited by mhupp
made links clickable
  • Like 1
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...