• Industries
  • Products
  • Buy
  • Services & Support
  • Communities
  • Discussion Groups

    Visual LISP, AutoLISP and General Customization

    Reply
    New Member
    Posts: 1
    Registered: ‎10-19-2012

    pt to pt distance lsp needs some cleaning up

    130 Views, 2 Replies
    10-19-2012 10:25 AM
    (defun c:sst (/ midl dis psz pipe ppp) 
    (setq OLDOS (getvar "OSMODE" ))
    (setq olay (getvar "clayer" ))
    (setvar "dimzin" 1 )
    (setvar "attdia" 0 )
    (setvar "attreq" 1 )
    (while                  
    (setvar "OSMODE" 69 )
    (princ (strcat "\n Pipe Size:< ")) (princ ppp)
    (INITGET 6)  
    (setq psz (GETSTRING " >: "))
    (if (= PSZ "")(setq PSZ pipe))
    (cond
    ((= psz "1" )(setq pipe "1" ) (setq ppp "1\"" ))
    ((= psz "1~" )(setq pipe "1~" )(setq ppp "1-1/4\"" ))
    ((= psz "1`" )(setq pipe "1`" )(setq ppp "1-1/2\"" ))
    ((= psz "2" )(setq pipe "2" )(setq ppp "2\"" ))
    ((= psz "2`" )(setq pipe "2`" )(setq ppp "2-1/2\"" ))
    ((= psz "3" )(setq pipe "3" )(setq ppp "3\"" ))
    ((= psz "4" )(setq pipe "4" )(setq ppp "4\"" ))
    ((= psz "6" )(setq pipe "6" )(setq ppp "6\"" ))
    ((= psz "8" )(setq pipe "8" )(setq ppp "8\"" ))
    ((= psz "10" )(setq pipe "10" )(setq ppp "10\"" ))
    )
                         	(if (setq pt1 (getpoint "\nFirst point: "))
                             (= pt1 "")(setq pt1 pt3))                
    			(setq pt2 (getpoint "\nSecond point: ")) 
    (if (= pt2 nill )(setvar "clayer" olay )
    (SETVAR "OSMODE" OLDOS )  )           
    			(setq MX (/ (+ (car PT1) (car PT2)) 2)
    		         MY (/ (+ (cadr PT1) (cadr PT2)) 2)
    		           MIDL (list MX MY 0))
    		  	(setq dis (distance pt1 pt2 ))
    			(setq ang (angle pt1 pt2 ))
            (if (>= ang 0)
              (setq ang1 ang)
            )
            (if (> ang 1.5708);same as 90°
              (setq ang1 (+ 3.14159 ang));add 180°
            )
            (if (>= ang 4.71413);same as 270.1°
              (setq ang1 ang)
            )
    
    			(setq angd (rtd ang1 ))
    			(setq dis (rtos dis 4 0 ))
                            (setvar "OSMODE" 0 )
                            (command "-layer" "m" "PTAG" "c" "7" "" "")
    			(command "insert" "P_TAG" midl binssc binssc angd dis pSZ "") 
                    (setq pt3 pt2)
                    (setq attent (entget (entlast)))	
    	        (setq atttag (cdr (assoc 2 attent )))
                    (setq entn (entget (entnext (cdr (car attent)))))
    		(setq attnam (cdr (assoc 2 entn )))
    	        (setq atttag (cdr (assoc 2 entn )))
                                    (if (= attnam atttag)
    				(progn
    				(setq str (cdr (assoc 1 entn )))
    				(setq strl (strlen str ))
    					(cond   ((= (wcmatch str "#\.") T ) (setq stal 2 ))
                                                    ((= (wcmatch str "##\.") T ) (setq stal 3 ))
                                                    ((= (wcmatch str "#.-#\.") T ) (setq stal 4 ))
    						((= (wcmatch str "#.-##\.") T ) (setq stal 5 ))
    						((= (wcmatch str "##.-#\.") T ) (setq stal 6 ))
    						((= (wcmatch str "##.-##\.") T ) (setq stal 7 ))
    						((= (wcmatch str "###.-#\.") T ) (setq stal 8 ))
    						((= (wcmatch str "###.-##\.") T ) (setq stal 9 ))
    					)
    				(setq stnum (substr str 1 stal ))
    				(setq rstal (+ stal 1 ))
    				(setq strest (substr str rstal strl ))
    				(setq stnuml (strlen stnum ))
    					(cond  ((= stnuml 2 )
    						(setq p1 "0-" )
    						(setq p2 (substr stnum 1 1 ))
    						)
                                                    ((= stnuml 3 )
    						(setq p1 "0-" )
    						(setq p2 (substr stnum 1 2 ))
    						)
                                                    ((= stnuml 4 )
    						(setq p1 (substr stnum 1 1 ))
    						(setq p2 (substr stnum 4 4 ))
    						)
    						((= stnuml 5 )
    						(setq p1 (substr stnum 1 1 ))
    						(setq p2 (substr stnum 4 5 ))
    						)
    						((= stnuml 6 )
    						(setq p1 (substr stnum 1 2 ))
    						(setq p2 (substr stnum 5 5 ))
    						)
    						((= stnuml 7 )
    						(setq p1 (substr stnum 1 2 ))
    						(setq p2 (substr stnum 5 6 ))
    						)
    						((= stnuml 8 )
    						(setq p1 (substr stnum 1 3 ))
    						(setq p2 (substr stnum 6 6 ))
    						)
    						((= stnuml 9 )
    						(setq p1 (substr stnum 1 3 ))
    						(setq p2 (substr stnum 6 7 ))
    						)
    					)
                                    (setq P1I (atoi P1 ))
                                    (setq P2I (atoi P2 ))
                                    (setq PP1 (itoa P1I))
                                    (setq PP2 (itoa P2I))
    				(setq NN1 (strcat PP1 "-" PP2 ))
    				(setq newatt NN1 )
    				(setq entn (subst (cons 1 newatt ) (assoc 1 entn ) entn ))
    				(entmod entn )
                                    (entupd (entlast)) 
    				);progn
    				);if
    );while
    (setvar "clayer" olay )
    (SETVAR "OSMODE" OLDOS )   
    )

     

    I use this lsp to place pipe size and distance from picked point to picked point. I know it is written poorly and could use some help cleaing it up. Take a look and see if you have any ideas at making it better.

     

     

    Please use plain text.
    *Expert Elite*
    Kent1Cooper
    Posts: 4,089
    Registered: ‎09-13-2004

    Re: pt to pt distance lsp needs some cleaning up

    10-19-2012 01:06 PM in reply to: danm4352

    The attached contains some comments and suggestions, but not about everything yet -- see the questions at the beginning of the attribute-text-content portion.

    Kent Cooper
    Please use plain text.
    *Expert Elite*
    Kent1Cooper
    Posts: 4,089
    Registered: ‎09-13-2004

    Re: pt to pt distance lsp needs some cleaning up

    10-22-2012 07:57 AM in reply to: danm4352

    I dug a little deeper into this, and actually tested it a little, so among the other improvements, I included the missing quotation mark in one of the prompts in my first attachment.

     

    The one obviously named that way is 'stripped' of most commentary and all commented-out parts from the original.

     

    Consider also defining the (rtd) function and/or the 'binssc' variable within the file, just in case....

    Kent Cooper
    Please use plain text.