Viết Lisp theo yêu cầu

[duy782006 1.544]

Nối thử đoạn mã này với đoạn mã trước thấy vẫn sai.

Bạn hãy copy y nguyên đoạn mã hoàn chỉnh chạy đúng ở máy bạn lên diễn đàn.

Như thế này chẳng biết mã của bạn đang viết gì nữa.

Đây gửi file lisp luôn nhờ bác xem hộ!

http://www.cadviet.com/upfiles/tienichveht.lsp

[Nguyen Hoanh 4.663]

Đây gửi file lisp luôn nhờ bác xem hộ!

http://www.cadviet.com/upfiles/tienichveht.lsp

Tôi sửa dòng lệnh

(setq dolondaucatt (getstring (strcat"\nDo lon mui ten :")))

thành:

(setq tmp (getstring (strcat"\nDo lon mui ten :")))

 

Và thêm dòng lệnh

(if (/= tmp "") (setq dolondaucatt tmp))

 

Có 2 dòng lệnh của bạn bị thừa (tôi đã cho dấu chấm phẩy ở trước). Sở dĩ thừa do bạn thừa từ hàm Initget (tôi cũng đã sửa lại).

 

Đoạn mã trở thành:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;
(Defun C:dcl ( )
(DCL))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;
(defun dcl ( )
(setvar "MODEMACRO" "VE NAT CAT LUNG")
(princ "\nPHAM QUOC DUY Binh Son - Quang ngai")
 (if (null kieudau)(setq kieudau "Z"))
 (if (null dolondaucatt)(setq dolondaucatt "100"))
(Setq temp T)
(While temp
(setq a (strcat "\nKieu dau hien hanh la("kieudau")/ Do lon dau cat (" dolondaucatt ") : "))  
(Initget "K D")
(setq str (getpoint a))
(Cond
 ((= str "K") (setq kieudau (strcase (getstring 5"\nKieu dau cat  : "))))
 ;((= str "k") (setq kieudau (strcase (getstring 5"\nKieu dau cat  : "))))
 ;((= str "d") (setq dolondaucatt (getstring (strcat"\nDo lon mui ten  :"))))
 ((= str "D") (setq tmp (getstring (strcat"\nDo lon mui ten  :"))))

  (Progn
 (Setq a str)
  (setq temp nil)
 )
)
 (if (/= tmp "") (setq dolondaucatt tmp))
)
 (setq b (getpoint a"\nDiem thu hai: "))


 (luuos)
 (setvar "osmode" 0)

    (setq dolondaucat (atof dolondaucatt)) 
 (setq  daitong (distance a :unsure:)
 (setq  daitru (- daitong dolondaucat))
 (setq  dainua (/ daitru 2))
 (setq  daicong (+ dainua dolondaucat))
    (setq goc(angle a :unsure:)
    (setq c (polar a goc dainua))
    (setq d (polar a goc daicong))
 (setq  ngannua (/ dolondaucat 2))
 (setq  nganmot (/ dolondaucat 4))
 (setq  nganba (* nganmot 3))
 (setq  gocp (- goc (/ pi 2)))
   (setq e (polar c gocp ngannua))
 (setq  goct (+ goc (/ pi 2)))
   (setq f (polar d goct ngannua))
   (setq g (polar a goc (/ daitong 2)))
   (setq h (polar g goct dolondaucat))
   (setq i (polar g gocp dolondaucat))
   (setq k (polar c goc nganmot))
   (setq l (polar k goct ngannua))
   (setq m (polar c goc nganba))
   (setq n (polar m gocp ngannua))


(Cond
((= "Z" kieudau)   
(command ".Pline" a c e f d b "")
         (COMMAND ".PEDIT" "last" "W" "0" "") 
)
((= "N" kieudau)   
(command ".Pline" a c h i d b "")
         (COMMAND ".PEDIT" "last" "W" "0" "") 
)
((= "S" kieudau)   
(command ".Pline" a c "a" "s" l g "s" n d "l" b "")
         (COMMAND ".PEDIT" "last" "W" "0" "") 
)
)


(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
 (traos)



     (Prin I)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;----------
(defun luuos ()
 (setq
   DUY_OSMODE   (getvar "OSMODE")
   DUY_AUTOSNAP (getvar "AUTOSNAP")
  DUY_LAYERHH (getvar "CLAYER")
  DUY_THANGXEOHH (getvar "ORTHO")
  DUY_filletrad (getvar "FILLETRAD")
 DUY_TEXTSTYLE (getvar "TEXTSTYLE")
  )
)
(defun traos ()
 (if DUY_OSMODE
   (setvar "OSMODE" DUY_OSMODE)
 )
 (if DUY_LAYERHH
   (setvar "CLAYER" DUY_LAYERHH)
 )
 (if DUY_THANGXEOHH
   (setvar "ORTHO" DUY_THANGXEOHH)
 )
 (if DUY_AUTOSNAP
   (setvar "AUTOSNAP" DUY_AUTOSNAP)
 )
(if DUY_filletrad
   (setvar "FILLETRAD" DUY_filletrad)
 )
(if DUY_TEXTSTYLE
   (setvar "TEXTSTYLE" DUY_TEXTSTYLE)
 )


)
;;----------

[duy782006 1.544]

Tôi sửa dòng lệnh

(setq dolondaucatt (getstring (strcat"\nDo lon mui ten <" dolondaucatt "> :")))

thành:

(setq tmp (getstring (strcat"\nDo lon mui ten <" dolondaucatt "> :")))

 

Và thêm dòng lệnh

(if (/= tmp "") (setq dolondaucatt tmp))

 

Có 2 dòng lệnh của bạn bị thừa (tôi đã cho dấu chấm phẩy ở trước). Sở dĩ thừa do bạn thừa từ hàm Initget (tôi cũng đã sửa lại).

 

Cám ơn bác nhìu !

[xaydung 12]

Xin lisp move đối tượng khi nhập khoảng cách:

Các bác ơi mình đang cần 1 lisp có nội dung như sau:

chạy lisp hỏi chọn đối tượng, nhập khoảng cách move theo trục Z(có thể nhập 2 điểm trên màn hình)

CT sẽ move đối tượng lên theo trục Z với khoảng cách vừa nhập.

thanks các bác!

[Nguyen Hoanh 4.663]

Xin lisp move đối tượng khi nhập khoảng cách:

Các bác ơi mình đang cần 1 lisp có nội dung như sau:

chạy lisp hỏi chọn đối tượng, nhập khoảng cách move theo trục Z(có thể nhập 2 điểm trên màn hình)

CT sẽ move đối tượng lên theo trục Z với khoảng cách vừa nhập.

thanks các bác!

Bạn tự viết đi! Từ những đoạn mã lệnh tương tự mà tôi đã viết rất nhiều trên mục này.

Biết rằng: hàm (getdist) sẽ cho phép nhập vào một khoảng cách.

[congtrinh5 0]

Các anh ơi cho em xin lisp etrude đối tượng lên theo hướng vuông góc mặt phẳng XY

(bình thường là extrude lên theo hướng vuông góc với mặt phẳng đối tượng)

thanks!

[tuanpecc1 2]

Mình đang thiết kế bản vẽ trên bình đồ có các đường đồng mức là pline (ở các cao độ khác nhau). Mình muốn xin 1 lisp mà có thể break các điểm đầu của đường đồng mức cùng một lúc trong phạm vi giới hạn bởi 1 đường pline bất kỳ khác. Mình biết trên diễn đàn đã có lisp break tại một điểm (lệnh bf) nhưng phải làm từng đối tượng thì rất lâu. Xin các cao thủ giúp đỡ mình với. thx

[tuanpecc1 2]

Mình đang thiết kế bản vẽ trên bình đồ có các đường đồng mức là pline (ở các cao độ khác nhau). Mình muốn xin 1 lisp mà có thể break các điểm đầu của đường đồng mức cùng một lúc trong phạm vi giới hạn bởi 1 đường pline bất kỳ khác. Mình biết trên diễn đàn đã có lisp break tại một điểm (lệnh bf) nhưng phải làm từng đối tượng thì rất lâu. Xin các cao thủ giúp đỡ mình với. thx

[pdhuy 0]

Bạn dùng lệnh trong cad cũng được : kẻ 1 pline sau đó trim, bấm chuột phải xong bấm f thế là xong.

[tvduc 0]

các Bác "List" lơi! Bác có thể viết giùm tôi một list để vẽ một đường thẳng mà điểm bắt đầu là trọng tâm của một hình nào đó được không.

hay Bác có thể tách ra luôn.

01 Vẽ một điểm tại trọng tâm của hình đó.

02 Vẽ đường thẳng mà điểm xuất phát từ trọng tâm hình đó.

Cảm ơn Bác "List" nhiều.

[Nguyen Hoanh 4.663]

các Bác "List" lơi! Bác có thể viết giùm tôi một list để vẽ một đường thẳng mà điểm bắt đầu là trọng tâm của một hình nào đó được không.

hay Bác có thể tách ra luôn.

01 Vẽ một điểm tại trọng tâm của hình đó.

02 Vẽ đường thẳng mà điểm xuất phát từ trọng tâm hình đó.

Cảm ơn Bác "List" nhiều.

http://www.cadviet.com/forum/index.php?showtopic=1694

bạn xem ở đây!

[tvduc 0]

http://www.cadviet.com/forum/index.php?showtopic=1694

bạn xem ở đây!

 

Cam on Bac Hoang rat rat nhieu!

À bac Hoang ơi cho toi hoi luon cau nay nhe.

trong Layout neu thao tac tren do chung ta tat di mot lop nao do roi, muon cho hien thi lai thi lam nhu the nao cho nhanh toi cung lenh Layon vẫn không đươc ma phai vao layers phai bở đi thuộc tính Freeze moi được, nhưng thao tác the nào lâu quá Bác à, bac co cach nao nhanh hon không?

[Nguyen Hoanh 4.663]

Cam on Bac Hoang rat rat nhieu!

À bac Hoang ơi cho toi hoi luon cau nay nhe.

trong Layout neu thao tac tren do chung ta tat di mot lop nao do roi, muon cho hien thi lai thi lam nhu the nao cho nhanh toi cung lenh Layon vẫn không đươc ma phai vao layers phai bở đi thuộc tính Freeze moi được, nhưng thao tác the nào lâu quá Bác à, bac co cach nao nhanh hon không?

ở đây không trả lời câu hỏi về CAD bạn ạ.

Bạn hãy post câu hỏi vào mục câu hỏi thường gặp.

bạn phải post tiếng Việt có dấu!

[congtrinh5 0]

tìm lisp modify lype type scale có nội dung sau:

trên màn hình em có 1 đường đứt (LT dạng hidden chẳng hạn)

chạy lisp hỏi chọn đường , nhập tỉ lệ lype type scale mới.

(chú ý: không giống lệnh LTS vì lệnh này ảnh hưởng đến toàn bộ các đường).

các bác giúp em nha?!!

[Nguyen Hoanh 4.663]

tìm lisp modify lype type scale có nội dung sau:

trên màn hình em có 1 đường đứt (LT dạng hidden chẳng hạn)

chạy lisp hỏi chọn đường , nhập tỉ lệ lype type scale mới.

(chú ý: không giống lệnh LTS vì lệnh này ảnh hưởng đến toàn bộ các đường).

các bác giúp em nha?!!

Lệnh là SLT:

(defun c:slt()

(command ".chprop" (ssget) "" "ltScale" pause "")(princ)

)

[dmg 0]

bác ssg ơi, nâng cấp hộ anh em cái lisp nha, cải tiến lại lisp đánh dây angten như sau:

ví dụ, đầu tiên em vẽ 1 doạn pline là L mét xong nhé, thực ra khi em kéo pline, làm sao mà chuẩn 100% nó là L được, ví dụ vẽ đoạn 10m (tức là trên bản cad vẽ 1 đoạn dài 10000), thì thực ra nó là 9,87m, hoặc 10,17m... em kéo tay thôi, nên luôn có sai số, mà em muốn thể hiện trên bản vẽ là:

L/L*0,97 (ví dụ: 10/9,70m)

 

ở đây em muốn lisp đọc độ dài pline xong sẽ làm tròn nó về số nguyên trước đã, làm tròn theo nguyên tắc excel: dưới 0,5 cho về 0, từ 0,5 trở lên tính thành 1, ví dụ: 2,4->2; 2,5->3....

sau đó quy cách thể hiện text độ dài dây angten vẫn như cũ thôi: chiều dài dây/chiều dài dây nhân 0,97

ví dụ: 10/9,70m tức là con số đầu ko có số nào sau dấu phẩy, còn con số sau để 2 số sau dấu phẩy.

 

bác ssg giúp em nhé

:unsure:

[ssg 1.102]

bác ssg ơi, nâng cấp hộ anh em cái lisp nha, cải tiến lại lisp đánh dây angten như sau:

ví dụ, đầu tiên em vẽ 1 doạn pline là L mét xong nhé, thực ra khi em kéo pline, làm sao mà chuẩn 100% nó là L được, ví dụ vẽ đoạn 10m (tức là trên bản cad vẽ 1 đoạn dài 10000), thì thực ra nó là 9,87m, hoặc 10,17m... em kéo tay thôi, nên luôn có sai số, mà em muốn thể hiện trên bản vẽ là:

L/L*0,97 (ví dụ: 10/9,70m)

 

ở đây em muốn lisp đọc độ dài pline xong sẽ làm tròn nó về số nguyên trước đã, làm tròn theo nguyên tắc excel: dưới 0,5 cho về 0, từ 0,5 trở lên tính thành 1, ví dụ: 2,4->2; 2,5->3....

sau đó quy cách thể hiện text độ dài dây angten vẫn như cũ thôi: chiều dài dây/chiều dài dây nhân 0,97

ví dụ: 10/9,70m tức là con số đầu ko có số nào sau dấu phẩy, còn con số sau để 2 số sau dấu phẩy.

 

bác ssg giúp em nhé

:unsure:

Chẳng cần phải nâng cấp! Chỉ cần set lại Units trong bản vẽ của bạn. Cụ thể:

Lệnh Units. Chọn Length - Precision, chọn 0

Hoặc:

Gõ LUPREC, chọn 0

[duy782006 1.544]

Nhờ bà con giúp giùm đoạn lisp này với:

-Yêu cầu nhập vào 1 điểm (pick bằng chuột)

-Kiểm tra vùng chọn có khép kín không:

+nếu kín thì gán cho diemchona bằng điểm vừa chọn.

+nếu không kín thì yêu cầu chọn lại đến khi kín thì thôi.

Cám ơn bà con !

Chúc cả nhà vui vẻ ! :unsure:

[ssg 1.102]

Chẳng cần phải nâng cấp! Chỉ cần set lại Units trong bản vẽ của bạn. Cụ thể:

Lệnh Units. Chọn Length - Precision, chọn 0

Hoặc:

Gõ LUPREC, chọn 0

I'm sorry! Đọc chưa kỹ yêu cầu của bạn.

Chỉ cần thêm hàm round và sửa 1 dòng lệnh là OK. Không cần set lại Units, bạn cứ để precision 0.0000 cũng được.

Code đã sửa:

 

(Defun round(x i / j) ;;;Round x, i digit after decimal point, return REAL
   (setq j (expt 10 i))
   (/ (float (fix (+ 0.5 (* x j)))) j) 
) 
;;;------------------------------------------------------------------------------------
(defun getTw() ;;;Get current text width factor
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh( / Th) ;;;Get current textheight or textsize
(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p)
;;;Write text S at point p by entmake function
;;;Text style, heigh and width factor get from current values
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))
    (cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun calcL (e) ;;;Calculate length of Line, Pline, 3dPoly, Spline, Circle, Arc, Polygon
   (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;------------------------------------------------------------------------------------
(defun C:LL( / Opt S1 S2 e p L)
(vl-load-com)
(if (not preT) (setq preT "L="))
(if (not sufT) (setq sufT ""))
(setq S1 preT S2 sufT)
(prompt (strcat "\nMeasure and write length. Current prefix:[" preT "]\tSuffix:[" sufT "]"))
(initget "Y N")
(setq Opt (getkword "\nChange prefix and suffix? [Yes/No] :"))
(if (not Opt) (setq Opt "N"))
(if (= Opt "Y") (progn
   (setq
       S1 (getstring "\nPrefix :") preT S1
       S2 (getstring "\nSuffix :") sufT S2
   )
))
(while (setq e (car (entsel "\nSelect Object or :")))
   (setq
       p (getpoint "\nBase point: ")
       L (calcL e)
   )
   (emkT (strcat S1 (rtos (round L 0)) "/" (rtos (round (* L 0.97) 2)) S2) p)
)
(princ)
)
;;;------------------------------------------------------------------------------------

[ssg 1.102]

Nhờ bà con giúp giùm đoạn lisp này với:

-Yêu cầu nhập vào 1 điểm (pick bằng chuột)

-Kiểm tra vùng chọn có khép kín không:

+nếu kín thì gán cho diemchona bằng điểm vừa chọn.

+nếu không kín thì yêu cầu chọn lại đến khi kín thì thôi.

Cám ơn bà con !

Chúc cả nhà vui vẻ ! :unsure:

Chưa tìm ra cách gì hay hơn, bạn dùng tạm kiểu này xem có được không (C:TEST là để kiểm tra, bạn tùy nghi sử dụng boundpt theo ý riêng).

Thực chất của phương pháp là nhờ command "boundary" tìm hộ. Nhược điểm của nó giống như của chính bản thân lệnh boundary và lệnh hatch:

- Vùng được chọn phải hiển thị đầy đủ trên màn hình

- Nếu khoảng hở quá nhỏ, nó cũng bỏ qua luôn!

Tóm lại là những vùng mà lệnh boundary hoặc hatch thực hiện được thì hàm boundpt sẽ cho kết quả T (true)

 

;;;--------------------------------------------------------------------------
(defun boundpt (p / e res)
;;;Return T if p is in a closed area. Otherwise return nil
(setq e (entlast))
(command "boundary" p "")
(setq res (not (equal (entlast) e)))
(if res (command "erase" (entlast) ""))
res
)
;;;--------------------------------------------------------------------------
(defun C:TEST( / p);;;Test boundpt function
(setq p (getpoint "\nPick a point:"))
(if (boundPt p) (alert "Closed") (alert "Unclosed"))
(princ)
)
;;;--------------------------------------------------------------------------

[duy782006 1.544]

Chưa tìm ra cách gì hay hơn, bạn dùng tạm kiểu này xem có được không (C:TEST là để kiểm tra, bạn tùy nghi sử dụng boundpt theo ý riêng).

 

Cám ơn SGG đúng cái mình cần !!

[congtrinh5 0]

Tìm lisp chọn 1 dim (hoặc nhiều dim 1 lúc) thì font của chữ của dim(nằm trên đường kích) sẽ chuyển thành

font simplex.shx! thanks các bác , em đang rất cần!!!?

[ssg 1.102]

Tìm lisp chọn 1 dim (hoặc nhiều dim 1 lúc) thì font của chữ của dim(nằm trên đường kích) sẽ chuyển thành

font simplex.shx! thanks các bác , em đang rất cần!!!?

;;;------------------------------------------------------------------------------------------
(defun C:CDT( / ss oldstyle);;;Change Dimension Text to simplex font
(if (not (tblsearch "style" "simplex")) (progn
(setq oldstyle (getvar "textstyle"))
(command "style" "simplex" "simplex" 0 1 0 "n" "n" "n")
(setvar "textstyle" oldstyle)
))
(setq ss (ssget '((0 . "DIMENSION"))))
(command "dimoverride" "dimtxsty" "simplex" "" ss "")
)
;;;------------------------------------------------------------------------------------------

 

Bạn phải có font simplex.shx trong thư mục Fonts của Acad.

[dmg 0]

bác ssg ơi, bác đã đánh thử chưa, sao em vẫn bị dạng 10.00/9.70m nhỉ. ko bít làm sao cho về được 10/9.70m

chỉ có 1 bản ko bít em ấn loạn xị ngậu thế nào mà lại đúng được dạng như em mong muốn, thế là em cứ cop các bản vẽ khác paste vào để đánh chiều dài dây awngten mà ko bít vì sao bản cad đó lại thể hiện text đúng được dạng chiều dài làm tròn (0 có con số 0 nào sau dấu phẩy)/ chiều dài*0,97 (2 con số không sau dấu phẩy). dẫu sao cũng cảm ơn bác nhìu. :unsure:

[ssg 1.102]

bác ssg ơi, bác đã đánh thử chưa, sao em vẫn bị dạng 10.00/9.70m nhỉ. ko bít làm sao cho về được 10/9.70m

chỉ có 1 bản ko bít em ấn loạn xị ngậu thế nào mà lại đúng được dạng như em mong muốn, thế là em cứ cop các bản vẽ khác paste vào để đánh chiều dài dây awngten mà ko bít vì sao bản cad đó lại thể hiện text đúng được dạng chiều dài làm tròn (0 có con số 0 nào sau dấu phẩy)/ chiều dài*0,97 (2 con số không sau dấu phẩy). dẫu sao cũng cảm ơn bác nhìu. :unsure:

Mình không bao giờ bỏ qua bước test khi lập trình. Tuy nhiên, cũng có thể là chưa lường hết các trường hợp có thể xảy ra. Nghe bạn phản hồi, mình đã test lại, kết quả vẫn đúng! Chả hiểu trên máy bạn thế nào!

Thôi được, bạn hãy delete toàn bộ "tàn tích" của các code trước đây, thay bằng đoạn sau. Hy vọng là sẽ đúng ý trong mọi trường hợp:

 

;;;-------------------------------------------------------------------------------
(Defun rnd(x) (fix (+ 0.5 x)) ) ;;;Round x, return INT
;;;-------------------------------------------------------------------------------
(Defun round(x i / j) ;;;Round x, i digit after decimal point, return INT
   (setq j (expt 10 i))
   (/ (float (fix (+ 0.5 (* x j)))) j) 
) ;;;return REAL
;;;------------------------------------------------------------------------------------
(defun getTw() ;;;Get current text width factor
(cdr (assoc 41 (tblsearch "style" (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun getTh( / Th) ;;;Get current textheight or textsize
(if (= (setq Th (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) 0) (getvar "textsize") Th)
)
;;;------------------------------------------------------------------------------------
(defun emkT (S p)
;;;Write text S at point p by entmake function
;;;Text style, heigh and width factor get from current values
(entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 (getTh))
    (cons 41 (getTw)) (cons 1 S) (cons 7 (getvar "textstyle"))))
)
;;;------------------------------------------------------------------------------------
(defun calcL (e) ;;;Calculate length of Line, Pline, 3dPoly, Spline, Circle, Arc, Polygon
   (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
)
;;;------------------------------------------------------------------------------------
(defun C:LL( / Opt S1 S2 e p L)
(vl-load-com)
(if (not preT) (setq preT "L="))
(if (not sufT) (setq sufT ""))
(setq S1 preT S2 sufT)
(prompt (strcat "\nMeasure and write length. Current prefix:[" preT "]\tSuffix:[" sufT "]"))
(initget "Y N")
(setq Opt (getkword "\nChange prefix and suffix? [Yes/No] :"))
(if (not Opt) (setq Opt "N"))
(if (= Opt "Y") (progn
   (setq
       S1 (getstring "\nPrefix :") preT S1
       S2 (getstring "\nSuffix :") sufT S2
   )
))
(while (setq e (car (entsel "\nSelect Object or :")))
   (setq
       p (getpoint "\nBase point: ")
       L (calcL e)
   )
   (emkT (strcat S1 (itoa (rnd L)) "/" (rtos (round (* L 0.97) 2)) S2) p)
)
(princ)
)
;;;------------------------------------------------------------------------------------