Jump to content

change this lisp for writing vertical only

mohammadreza

By mohammadreza
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mohammadreza Enthusiast

mohammadreza

Posted
Posted

hi dear friends
could you help me to change  this below code for writing vertical only? actually i no need to ask the user for enter rotation and height !
i just need to modify this code for 2 type of rotation. vertical and horizontal.
i tried before but i think there is a variable that it save and doesn't permit to use other type.
i mean when i change code for vertical , keep the angle and cant switch to horizontal!!! i hope you understood my purpose . 

						       ;(textscr)
						       ;(princ "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n")
						       ;(princ "\n*********** DEMO CO.  PRESENT **LICENSE TO A.AMIRPOUR *********")
						       ;(princ "\n\n  FARSI interpreter Version 5.00 Is loading .")

(defun r_t_d (d)
  (setq d (/ (* d 180.0) pi))
)

(defun lic_pr ()
  (princ "This software is licensed to A.AMIRPOUR.\n")
)

(defun lst (d) (setvar "lastpoint" st))

(princ ".")

(defun d_t_r (d)
  (setq d (/ (* d pi) 180.0))
)

(princ ".")

(setq charm1 (list 104 151 152 153 78 110 169 170 171 66 98 133	134 135	67 99 136 137 138 70 92	124 211	212 213	44 226 227 228 60 229 230 231 62 232
		   233 234 235 236 237 32 71 72	86 118 193 194 195 167 168)
)
(setq charm2 (list 32 33 35 36 37 38 40	41 42 43 45 46 47 48 49	50 51 52 53 54 55 56 57	61 63 64 94 127	128 129)
)
(setq charm (append charm1 charm2))
(setq charn (append charm2 (list 32 70 71 72)))
(setq charo (list (list 96 126)
		  (list 58 127)
		  (list 59 127)
		  (list 34 128)
		  (list 39 128)
		  (list 44 129)
		  (list 60 131)
		  (list 62 132)
	    )
)
(setq charp (list 96 58 59 34 39 44 60 62))
(setq charq (list 104 110 98 99 118 124 129 130 131))

(defun mirp (a b)
  (setq	x1 (car a)
	y1 (cadr a)
	x2 (car b)
	y2 (cadr b)
  )
  (setq pt3 (list (- (* 2 x1) x2) (- (* 2 y1) y2)))
  (setq an (angle a b))
)
(princ ".")

(defun taviz (so)
  (setq l (strlen so))
  (setq n 1)
  (setq nwo "")
  (while (<= n l)
    (if	(= n 1)
      (setq ee " ")
      (setq ee (substr so (1- n) 1))
    )
    (setq f (substr so n 1))
    (if	(= n l)
      (setq g " ")
      (setq g (substr so (1+ n) 1))
    )
    (setq asce (ascii ee))
    (setq ascff (setq ascf (ascii f)))
    (setq ascg (ascii g))
    (if	(= (member ascf charm2) nil)
      (if (= (member ascf (list 32 95 70 71 72)) nil)
	(progn
	  (if (/= (and (> ascf 64) (< ascf 94)) nil)
	    (setq ascff (setq ascf (+ ascf 32)))
	  )
	  (if (/= (member ascf charp) nil)
	    (setq ascf (car (cdr (assoc ascf charo))))
	  )
	  (if (/= (member asce charm) nil)
	    (if	(/= (member ascg charn) nil)
	      (if (= (member ascf charq) nil)
		(setq ascf (+ (* (- ascf 97) 3) 132))
		(setq ascf ascff)
	      )
	      (setq ascf ascff)
	    )
	    (if	(/= (member ascg charn) nil)
	      (if (= (member ascf charq) nil)
		(setq ascf (+ (* (- ascf 97) 3) 131))
		(setq ascf (+ (* (- ascf 97) 3) 130))
	      )
	      (setq ascf (+ (* (- ascf 97) 3) 130))
	    )
	  )
	)
      )
    )
    (setq n (1+ n))
    (setq nwo (strcat nwo (chr ascf)))
  )
  (setq so nwo)
)

(princ ".")

(defun hr ()
  (setq f_heigth (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
  (if (= f_heigth 0.0)
    (progn
      (princ
	(strcat "\nHeight <" (rtos (getvar "textsize")) ">: ")
      )
      (setq ht (getdist st))
      (if (/= ht nil)
	(setvar "textsize" ht)
	(setq ht "")
      )
    )
  )
  (princ (strcat "\nRotation angle <"
		 (angtos (getvar "userr1"))
		 ">: "
	 )
  )
  (setq ro (getangle st))
  (if (/= ro nil)
    (setvar "userr1" ro)
  )
)
(princ ".")

(defun *error* (ms)
  (if (= ms "Function cancelled")
    (progn (command) (command))
  )
  (princ "\nerror: ")
  (princ ms)
  (command "ERASE" ss "")
  (setvar "CMDECHO" 1)
  (setvar "HIGHLIGHT" 1)
  (setvar "BLIPMODE" 1)
  (prin1)
)

(princ ".")



(princ ".")


(defun farsit (text_to_convert)
  (setvar "CMDECHO" 0)
  (if (/= passcode "passcode")
    (progn
      (code_control)
      (if (= (and (= fcode fcodm)
		  (/= ucode nil)
		  (= scode "10-248253")
	     )
	     t
	  )
	(progn
	  (setq passcode "passcode")
	  (taviz text_to_convert)
	)
	(progn
	  (lic_pr)
	  (prin1)
	)
      )
    )
    (taviz text_to_convert)
  )
)

(princ ".")

(defun c:kateb ()
  (setvar "CMDECHO" 0)
  (setvar "HIGHLIGHT" 0)
  (setq ttxxtt (getvar 'textstyle))
;;;;;;
  (command "style" "NASKHD" "naskhd" "" "" "" "yes" "")
  (setvar "textstyle" "NASKHD")
  (princ (strcat "Current TEXT style is "
		 (getvar "TEXTSTYLE")
		 " !!\n"
	 )
  )
  (setq st (list 1 4))
  (setq ss (ssadd))
  (command "POINT" "0,0")
  (setq entl (entlast))
  (ssadd entl ss)
  (setq rp "Style")
  (while (= rp "Style")
    (initget "Style Align Center Fit Middle Left")
    (setq rp (getpoint
	       "Start point or Align/Center/Fit/Middle/Left/Style:"
	     )
    )
    (if	(= rp "Style")
      (progn
	(setq sty (getstring
		    (strcat "\nStyle name (or ?) <" (getvar "TEXTSTYLE") ">: ")
		  )
	)
	(if (/= sty "")
	  (progn
	    (if	(= sty "?")
	      (progn
		(command "TEXT" "S" "?")
		(command)
	      )
	      (progn
		(if (/= (tblsearch "style" sty) nil)
		  (progn
		    (command "TEXT" "S" (eval sty))
		    (command)
		  )
		  (prompt "\nUnknown text style name.\n")
		)
	      )
	    )
	  )
	)
      )
    )
  )
  (if (= (getvar "userr1") 0)
    (setvar "userr1" pi)
  )
  (if (= rp nil)
    (setq st nil)
  )
  (if (/= st nil)
    (progn
      (if (listp rp)
	(progn
	  (setq st rp)
	  (lst st)
	  (hr)
	)
      )
      (if (= rp "Align")
	(progn
	  (setq st (getpoint "\nFirst text line point:"))
	  (lst st)
	  (setq pt2 (getpoint st "\nSecond text line point:"))
	)
      )
      (if (= rp "Center")
	(progn
	  (setq st (getpoint "\nCenter point:"))
	  (lst st)
	  (hr)
	)
      )
      (if (= rp "Fit")
	(progn
	  (setq st (getpoint "\nFirst text line point:"))
	  (lst st)
	  (setq pt2 (getpoint st "\nSecond text line point:"))
	  (setq	f_heigth (cdr (assoc 40
				     (tblsearch	"style"
						(getvar "textstyle")
				     )
			      )
			 )
	  )
	  (if (= f_heigth 0.0)
	    (progn
	      (princ
		(strcat "\nHeight <" (rtos (getvar "textsize")) ">: ")
	      )
	      (setq ht (getdist st))
	      (if (/= ht nil)
		(setvar "textsize" ht)
		(setq ht "")
	      )
	    )
	  )
	)
      )
      (if (= rp "Middle")
	(progn
	  (setq st (getpoint "\nMiddle point:"))
	  (lst st)
	  (hr)
	)
      )
      (if (= rp "Left")
	(progn
	  (setq st (getpoint "\nLeft point:"))
	  (lst st)
	  (hr)
	)
      )
    )
  )
  (setq ro (+ (getvar "userr1") pi))
  (setq rl (getvar "AUNITS"))
  (cond	((= rl 0) (setq rog (angtos ro)))
	((= rl 1) (setq rog (angtos ro)))
	((= rl 2) (setq rog (atof (angtos ro))))
	((= rl 3) (setq rog (atof (angtos ro))))
	((= rl 4) (setq rog (r_t_d ro)))
  )
  (princ "\nText:")
  (if (= st nil)
    (command "dtext" "")
    (progn
      (if (listp rp)
	(if (= f_heigth 0.0)
	  (command "dtext" st ht rog)
	  (command "dtext" st rog)
	)
      )
      (if (= rp "Align")
	(progn
	  (mirp st pt2)
	  (command "dtext" "a" st pt3)
	)
      )
      (if (= rp "Center")
	(if (= f_heigth 0.0)
	  (command "dtext" "c" st ht rog)
	  (command "dtext" "c" st rog)
	)
      )
      (if (= rp "Fit")
	(progn
	  (mirp st pt2)
	  (if (= f_heigth 0.0)
	    (command "dtext" "f" st pt3 ht)
	    (command "dtext" "f" st pt3)
	  )
	)
      )
      (if (= rp "Middle")
	(if (= f_heigth 0.0)
	  (command "dtext" "m" st ht rog)
	  (command "dtext" "m" st rog)
	)
      )
      (if (= rp "Left")
	(if (= f_heigth 0.0)
	  (command "dtext" "r" st ht rog)
	  (command "dtext" "r" st rog)
	)
      )
    )
  )
  (while (/= (entnext entl) nil)
    (setq txt (entnext entl))
    (setq e (entget txt))
    (if	(or (= rp "Fit") (= rp "Align"))
      (progn (setq za (cdr (assoc 10 e)))
	     (command "ROTATE" (ssadd txt) "" za "180")
      )
    )
    (setq e (entget txt))
    (setq s (cdr (setq as (assoc 1 e))))
    (setq s (taviz s))
    (setq e (subst (cons 1 nwo) as e))
    (entmod e)
    (setq entl txt)
  )
  (command "ERASE" ss "")
  (setvar "HIGHLIGHT" 1)
  (setvar "CMDECHO" 1)
  (setvar "BLIPMODE" 1)
  (prin1)
  (setvar "textstyle" ttxxtt)
)

(princ ".")

(defun farsichange ()
  (setvar "CMDECHO" 0)
  (command "UNDO" "M")
  (setvar "BLIPMODE" 0)
  (setq	chm 0
	p   (ssget)
  )
  (if p
    (progn
      (setq cont t)
      (while cont
	(setq os (getstring "\n Type OLD text : " T))
	(setq osl (strlen os))
	(if (= osl 0)
	  (princ "Null input invalid. Try again !?")
	  (setq cont nil)
	)
      )
      (setq ns (getstring "\n Type NEW text : " T))
      (setq os (taviz os))
      (setq ns (taviz ns))
      (setq nsl (strlen ns))
      (setq l 0
	    n (sslength p)
      )
      (while (< l n)
	(if (= "TEXT"
	       (cdr (assoc 0 (setq ec (entget (ssname p l)))))
	    )
	  (progn
	    (setq chf nil
		  si  1
	    )
	    (setq sc (cdr (setq ass (assoc 1 ec))))
	    (while (= osl
		      (setq sl (strlen
				 (setq stc (substr sc si osl))
			       )
		      )
		   )
	      (if (= stc os)
		(progn
		  (setq	sc (strcat (substr sc 1 (1- si))
				   ns
				   (substr sc (+ si osl))
			   )
		  )
		  (setq chf t)
		  (setq si (+ si nsl))
		)
		(setq si (1+ si))
	      )
	    )
	    (if	chf
	      (progn
		(setq ec (subst (cons 1 sc) ass ec))
		(entmod ec)
		(setq chm (1+ chm))
	      )
	    )
	  )
	)
	(setq l (1+ l))
      )
    )
  )
  (princ "Changed ")
  (princ chm)
  (princ " text lines.")
  (command "UNDO" "E")
  (setvar "CMDECHO" 1)
  (setvar "BLIPMODE" 1)
  (prin1)
)

(princ ".")

(defun c:chg ()
  (setvar "CMDECHO" 0)
  (if (/= passcode "passcode")
    (progn
      (code_control)
      (if (= (and (= fcode fcodm)
		  (/= ucode nil)
		  (= scode "10-248253")
	     )
	     t
	  )
	(progn
	  (setq passcode "passcode")
	  (farsichange)
	)
	(progn
	  (lic_pr)
	  (prin1)
	)
      )
    )
    (farsichange)
  )
)

(princ ". Completed.")
(prin1)

 

BIGAL Grand Master

BIGAL

Posted
Posted

The code is missing some functions, (code_control) and what about "This software is licensed to A.AMIRPOUR.\n" is that you ?

 

Post a before and after dwg.

 

 

mohammadreza Enthusiast

mohammadreza

Posted
  • Author
Posted

9 hours ago, BIGAL said:

The code is missing some functions, (code_control) and what about "This software is licensed to A.AMIRPOUR.\n" is that you ?

 

Post a before and after dwg.

 

 

this is not me!
i just try to change code for typing vertical and horizontal without asking user
this code use for typing Persian language

1.png

2.png

3.png

4.png

6.png

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