Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
New Member
danm4352
Posts: 1
Registered: ‎10-19-2012
Message 1 of 3 (192 Views)

pt to pt distance lsp needs some cleaning up

192 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.

 

 

*Expert Elite*
Kent1Cooper
Posts: 5,418
Registered: ‎09-13-2004
Message 2 of 3 (178 Views)

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
*Expert Elite*
Kent1Cooper
Posts: 5,418
Registered: ‎09-13-2004
Message 3 of 3 (133 Views)

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
Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.