Jump to content

A little help needed with lisp program


karim-salem

Recommended Posts

hi,

I have a little problem with a lisp file that extract coordinates from DWG and label them with prefix and counters then export them to text file.

if anybody can advice how to exit this lisp correctly i would really appreciate it a lot.

 

(defun run ()
      (setq pll (getstring "\nPlease Enter of new file (name.ext) :"))
      (setq pl (open pll "w"))
      (setq ang ( getreal "\nPlease Enter DV Angle: " ) )
      (setq n ( getstring "\nPlease Enter TAXI name: " ) )
       (initget (+ 1 2 4))    
       (setq a ( getint "\nPlease Enter MH number: " ) )
       
      ;(setq e (getstring "\nget no. of first Point :"))
      ;(setq a (atoi e))
      
     
(while (> a 0)
       (setq aa 1)
           (while (<= aa 4)
               (setq p (getpoint "\nselect point :"))
               (setq v1 (strcat "\n " (itoa a) " " (itoa aa) "     "))
               (setq d (polar p (dtr 90) 0))
               (setq f (itoa aa))
               (setq k (itoa a))
               (setq g (strcat n "-" k "-P-" f))
               (command "layer" "m" "number" "c" "3" "" "")
               (command "text" "m" d 0.2 ang g)
               (setq num (entlast))
             ;(command "change" num "" "layer" "" number "") 
               (command "change" num "" "p" "layer" "number" "")  
               (command "layer" "m" "point" "c" "1" "" "")
               (command "point" p)
               (setq pt (entlast))
             ;(command "change" pt "" layer "" point "")   
               (command "change" pt "" "p" "layer" "point" "")
               (setq x (car p))
               (setq x (rtos x 2 4))
               (setq x (strcat x "             "))
               (setq v2 x)
               (setq y (cadr p))
               (setq y (rtos y 2 4))
               (setq y (strcat y "          "))
               (setq v3 y)
             
             (princ V1 pl)
              (princ v2 pl)
               (princ v3 pl)
             
           (setq aa (+ aa 1))
           )
           (setq a (+ a 1)) 
       )
      (command "layer" "m" "txt" "c" "5" "" "")
      (close pl)
      (redraw)
      (princ)
)
(defun c:I ()
      (run)
      (setq fil (getstring "\nget name of the file (name.ext) :"))
          (setq p1 (getpoint "select insertion point :"))
      (setq p2 (polar p1 0.0 35.0))
      (setq p3 (polar p1 0.0 105.0))
      (setq p4 (polar p1 (/ (* -1 pi) 2) 20.0))
      (setq p5 (polar p4 0.0 35.0))
      (setq p6 (polar p4 0.0 70.0))
      (setq p7 (polar p4 0.0 105.0))
      (setq p8 (polar p2 (/ (* -1 pi) 2) 10.0))
      (setq p9 (polar p8 0.0 35.0))
      (setq p10 (polar p8 0.0 70.0))
      (setq p11 (polar p8 (* -1 pi) 15.0))
      (setq p12 (polar p8 (/ pi 2) 5.0))
      (setq p13 (polar p8 (/ (* -1 pi) 2) 5.0))
      (setq p14 (polar p12 0.0 35.0))
      (setq p15 (polar p13 0.0 17.5))
      (setq p16 (polar p13 0.0 52.5))
      (setq p1- (polar p1 (/ (* -1 pi) 2) 2000000000.0))

      (command "text" "m" p11 3.0 0.0 "POINT NO.")
      (command "text" "m" p14 3.0 0.0 "COORDINATES")
      (command "text" "m" p15 3.0 0.0 "X")
      (command "text" "m" p16 3.0 0.0 "Y")

      (command "line" p1 p4 "")
      (setq L14 (entlast))
      (command "line" p2 p8 p5 "")
      (setq L285 (entlast))
      (command "line" p9 p6 "")
      (setq L96 (entlast))
      (command "line" p3 p10 p7 "")
      (setq L3107 (entlast))
      (command "line" p1 p2 p3 "")
      (command "line" p8 p9 p10 "")
      (command "pline" p4 p5 p6 p7 "")
      (setq L4567 (entlast))

      (setq fill (open fil "r"))
      
      (read-line fill)
      (setq new ())
      (setq j 0.0)
      (setq p44 p4)
      (while (setq S (read-line fill))
             (setq pt (polar p44 (/ (* -1 pi) 2) (+ 5 j)))
             (setq pt1 (polar pt 0.0 12.5))
             (setq pt2 (polar pt 0.0 50))
             (setq pt3 (polar pt 0.0 85))
             
             (setq t1 (substr S 1 4))
             (setq t11 (strcat n t1))
             (setq t2 (substr S 5 18))
             (setq t3 (substr S 23 32))
             
             (command "text" "m" pt1 3.0 0.0 t11)
             (command "text" "m" pt2 3.0 0.0 t2)
             (command "text" "m" pt3 3.0 0.0 t3)
             
             (setq p4 (polar p4 (/ (* -1 pi) 2) 10.0))
             (setq p5 (polar p5 (/ (* -1 pi) 2) 10.0))
             (setq p6 (polar p6 (/ (* -1 pi) 2) 10.0))  
             (setq p7 (polar p7 (/ (* -1 pi) 2) 10.0))    
             
             (command "offset" (+ j 10.0) (list L4567 p4) p1- "")
             (setq new (entlast))
             
             (command "extend" new "" (list L14 P4) "")
             (command "extend" new "" (list L285 p5) "")
             (command "extend" new "" (list L96 p6) "")
             (command "extend" new "" (list L3107 p7) "")
             (setq j (+ j 10.0))
      )
      ;(close)
      (close fill)
)
(defun dtr (x)
   ;define degrees to radians function

   (* pi ( / x 180.0))
   ;divide the angle by 180 then
   ;multiply the result by the constant PI

)
(princ)

Link to comment
Share on other sites

A couple of suggestions you seem to be doing a lot of layer make, why not just check for layer if not exist then make it and then just use (setvar "clayer" yourlayername)

 

Maybe also use mtext saves working out each row. Note the double slash P "\\P" is used for new line, and you use Strcat to join it all up.

 

(setq mytext (strcat "Row1" "[url="file://\\P"]\\P[/url]" "row2" "[url="file://\\P"]\\P[/url]" "row3"))
(command "MTEXT" "0,0" "Height" 50  "Width" "0" mytext "")

 

 

Last

(setq p (getpoint "\nselect point press <Cr> to exit:"))
(if (= p nil)(exit))

Edited by BIGAL
Link to comment
Share on other sites

thank you for your support.

yesterday i added an upper limit for the main loop and it did work for me.

 

(defun run ()
      (setq pll (getstring "\nPlease Enter of new file (name.ext) :"))
   (setq pl (open pll "w"))
      (setq ang ( getreal "\nPlease Enter DV Angle: " ) )
   (setq n ( getstring "\nPlease Enter TAXI name: " ) )
	(initget (+ 1 2 4))	
	(setq a ( getint "\nPlease Enter number of first MH : " ) )
	(setq als ( getint "\nPlease Enter number of last MH : " ) )
	
   ;(setq e (getstring "\nget no. of first Point :"))
      ;(setq a (atoi e))
      
     
(while (<= a als)
	(setq aa 1)
		(while (<= aa 4)
			(setq p (getpoint "\nselect point :"))
			(setq v1 (strcat "\n " (itoa a) "-" (itoa aa)))
			(setq d (polar p (dtr 90) 0))
			(setq f (itoa aa))
			(setq k (itoa a))
			(setq g (strcat n "-" k "-P-" f))
			(command "layer" "m" "number" "c" "3" "" "")
			(command "text" "m" d 0.2 ang g)
			(setq num (entlast))
             ;(command "change" num "" "layer" "" number "") 
			(command "change" num "" "p" "layer" "number" "")  
			(command "layer" "m" "point" "c" "1" "" "")
			(command "point" p)
			(setq pt (entlast))
             ;(command "change" pt "" layer "" point "")   
			(command "change" pt "" "p" "layer" "point" "")
			(setq x (car p))
			(setq x (rtos x 2 4))
			(setq x (strcat "     " x "           "))
			(setq v2 x)
			(setq y (cadr p))
			(setq y (rtos y 2 4))
			(setq y (strcat y "          "))
			(setq v3 y)
		  
             (princ V1 pl)
		   (princ v2 pl)
		    (princ v3 pl)
             
		(setq aa (+ aa 1))
		)
		(setq a (+ a 1)) 
	)
      (command "layer" "m" "txt" "c" "5" "" "")
      (close pl)
      (redraw)
      (princ)
)

 

i will try to optimize using your suggestions, i hope i don't mess things up.

 

thanks for everything mate

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.

×
×
  • Create New...