Chỉnh sửa lisp ghi kich thước text

[hung1608 8]

Mình có 1 cái lisp cop trên diễn đàn nay nhờ các bạn chỉnh sửa hộ mình tăng thêm 1 số yêu cầu của mình , để mình sư dụng thuận lợi hơn

1. Làm tròn số ( chẳng hạn như 1922 thành 1900 hay 2354 thanh 2400 ..)

2. Lisp có nhập chiều cao text nhưng không ghi nhớ cho những lần sử dụng lệnh tiếp theo rất bất tiện khi nhập lại , các bạn có thể tăng thêm cái nhớ chiều cao text cho mình

3. Chọn được font text

4 Ghi text ra song song với đường thẳng mình chọn ( làm được tùy biện chọn song song càng hay nhé )

5. Trong lisp có đoạn Chọn phương án nhập kết quả minh k hiểu nó là gì nữa

Yêu cầu hơi nhiều mong các bạn giúp đỡ vì nhu cầu công việc của mình càn nó

Thanks

[hung1608 8]

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/9681-lisp-ghi-chieu-dai-doan-thang-theo-scale-factor-cua-dimstyle-hien-thoi/
(defun Length1(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
;;;--------------------------------------------------------------------
(defun C:TL( / ss L e)
(setq
ss (ssget (list (cons 0 "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")))
L 0.0
k (getvar "dimlfac")
)

(vl-load-com)
(while (setq e (ssname ss 0))
(setq L (* k (length1 e)))
(setq ans (getstring "\n Ban hay chon phuong an nhap ket qua "))
(if (= ans "1")
(progn
(setq te (entget(car(entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
(progn
(setq p (getpoint "\n Chon diem nhap ket qua" ))
(setq h (getreal "\n Nhap chieu cao text ket qua "))
(command "text" p h "0" (rtos L 2 2))
)
)
(ssdel e ss)
)
(princ)
)
;;;--------------------------------------------------------------------

[hung1608 8]

file dinh kem

http://www.cadviet.com/upfiles/3/11317_ghi_kich_thuoc_text_len_doan_thangtl_1.lsp

[hung1608 8]

Hic không có bạn nào giúp mình àh :(

[Doan Van Ha 3.202]

Lisp down ở đâu thì hỏi ở đấy, dễ được tác giả trả lời.

Đường link trong file lisp vẫn còn, bạn nên trở lại đó để hỏi sẽ hiệu quả hơn.

[hung1608 8]

Lisp này lâu lắm rùi bạn àh, mình biết có bác Tuệ hình như có viết cái này và 1 người nữa là Phạm Thanh Bình thì phải

Help me

[Tot77 508]

Với yêu cầu của bạn thì cái lisp trên xem như đổi gần hết.

Chọn phương án nhập kết quả là nếu bạn nhập "1" nó sẽ ghi vào text có sẵn, còn không thì tạo text mới.

Lisp dưới đây bạn không cần nhập chiều cao chữ, font, nhưng phải có text mẫu trước, nó căn cứ trên text mẫu để tạo text mới giống y.

Sau khi chọn text mẫu, bạn nhấp vào từng đối tượng, vị trí text mới ở ngay điểm bạn nhấp, chiều thì theo hướng bạn chọn.

 

(defun C:TL (/ ss L e)

  (defun Length1 (e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

  (defun tronso(a B) (* b (if (< (rem a B) (* 0.5 B)) (fix (/ a b 1.)) (1+ (fix (/ a b 1.))))))

  (defun dxf(id v) (cdr (assoc id (entget v))))

  

  ;;==============================================;;

  

  (setq k (getvar "dimlfac")

chumau (car (entsel "Chon chu mau:"))

os (getvar 'osmode))

  

  (command "undo" "be")

  (setvar 'osmode 512)

  (vl-load-com)

  (while (setq e0 (entsel "\nChon LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE:"))  

 

    (if (vl-string-search (dxf 0 (setq e (car e0))) "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

      (progn

(setq pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) (last e0))

     pt1 (getpoint pt "Theo huong:"))

        (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 7 (dxf 7 chumau))

      (cons 72 0) (cons 50 (angle pt pt1))

      (cons 40 (dxf 40 chumau)) (cons 1 (rtos (tronso (* k (length1 e)) 100))))))

      (alert "Khong the do chieu dai doi tuong nay!!")

    )

  )

  (setvar 'osmode os)

  (command "undo" "e")

  (princ)

 

)

 

Bạn bỏ cái dòng <span...>  ở dưới đi

[hung1608 8]

Tuyệt vời bạn ơi, cảm ơn bạn rất nhiều

Bạn có thể chỉnh thêm cho mình 1 chút nữa được không

1. Text có tới 3 chữ số 0 đằng sau mình không cần chĩnh xác đến đó ( minh chỉ cần tròn số thôi ( chẳng hạn như 1922 thành 1900 hay 2354 thanh 2400 ..)

2. Text và đường thẳng sát nhau quá có thể điều chỉnh khoảng cách giữa text và đường thẳng được k bạn bởi sát nhau quá khi in nó bị trung nét

mà tại sao bỏ cái dòng <span...> vậy bạn

Thanks bạn

[phamthanhbinh 3.146]

Lisp này lâu lắm rùi bạn àh, mình biết có bác Tuệ hình như có viết cái này và 1 người nữa là Phạm Thanh Bình thì phải

Help me

Hề hề hề,

Ai kiu tui đó, có tui đây.

Thú thực là cai lisp này chẳng biết có phải do mình viết không nữa. Nhưng cứ theo những gì thể hiện trong lisp thì việc sửa nó theo yêu cầu của bạn không phải là không thể. Tuy nhiên bác Tot77 đã cho bạn cái lisp mới nên chẳng chắc là bạn còn cần sửa nữa hay không.

Nếu vẫn còn muốn sửa thì hãy thử tự sửa như sau xem có đạt yêu cầu không nhé:

1/- Thêm đoạn code sau đây vào ngay dưới dòng code : (setq L (* k (length1 e)))

(setq L (atof (rtos L 2 0)))

(if (<= (rem L 100) 50)

   (setq L (* (fix (/ L 100)) 100))

   (setq L (* (+ (fix (/ L 100)) 1) 100))

)

Đồng thời sửa các đoạn code (rtos L 2 2) thành

(rtos L 2 0)

 

2/- Thêm đoạn code sau đây vào phía trên dòng code: (setq h (getreal "\n Nhap chieu cao text ket qua "))

(if (not h)

và thêm một dấu ngoặc đóng   )  vào cuối dòng code (setq h (getreal "\n Nhap chieu cao text ket qua ")) này để thành 

(setq h (getreal "\n Nhap chieu cao text ket qua ")))

 

3/- Sau khi đã có text trên bản vẽ bạn có thể đổi font tùy ý bằng cách sử dụng lệnh style. bởi vì font sử dụng tùy thuộc vào style mà bạn muốn dùng. Việc đổi font trong style hiện hành có thể dẫn tới các text khác trên bản vẽ sẽ bị thay đổi theo. Vì vậy tốt nhất bạn nên tạo một style mới và đặt nó làm style hiện hành trước khi dùng lisp. Nếu bạn vẫn muốn đổi font của style hiện hành thì làm như sau:

- Thêm đoạn code sau đây vào phía dưới dòng code: (vl-load-com)

(setq fnt (getstring "\n Hay nhap ten day du cua file font muon dung: "))

(if (and fnt (/= fnt "") (/= fnt " "))

    (command "style" (getvar "Textstyle" ) fnt 0.0 1 0 N N )

)

Nên lưu ý rằng bạn phải nhập chính xác tên đầy đủ của file font bởi nếu nhập sai lisp sẽ không hoạt động. Mà các tên file này không hề dễ nhớ đâu . Do vậy nếu đã không nhớ chính xác thì bạn nên nhấn enter khi lisp yêu cầu nhập ten file font. Khi đó lisp sẽ sử dụng font của style hiện hành.

 

4/- Để text song song với đoạn thẳng chọn bạn cần sửa lisp như sau:

Thêm đoạn code dưới đây vào dưới dòng code: (setq p (getpoint "\n Chon diem nhap ket qua" ))

(setq p1 (vlax-curve-getclosestpointto (vlax-ename->vla-object e) p)

         p2 (vlax-curve-getpointatparam (vlax-ename->vla-object e) (+ (fix (vlax-curve-getparamatpoint (vlax-ename->vla-object e) p)) 1))

        a (angle p1 p2)

)

Đồng thời sửa dòng code: (command "text" p h "0" (rtos L 2 2)) thành

(command "text" p h a (rtos L 2 0))

 

5/- Bác Tot77 đã trả lời. Và như vậy việc đặt text xa hay gần, trên hay dưới đoạn thẳng bạn chọn hoàn toàn do bạn chớ không phải do lisp nữa.

 

Hy vọnng bạn thành công với việc sửa lisp này.

[Tot77 508]

Tuyệt vời bạn ơi, cảm ơn bạn rất nhiều

Bạn có thể chỉnh thêm cho mình 1 chút nữa được không

1. Text có tới 3 chữ số 0 đằng sau mình không cần chĩnh xác đến đó ( minh chỉ cần tròn số thôi ( chẳng hạn như 1922 thành 1900 hay 2354 thanh 2400 ..)

2. Text và đường thẳng sát nhau quá có thể điều chỉnh khoảng cách giữa text và đường thẳng được k bạn bởi sát nhau quá khi in nó bị trung nét

mà tại sao bỏ cái dòng <span...> vậy bạn

Thanks bạn

Sửa lại theo ý bạn, ở lisp này nếu bạn đã chon chữ mẫu 1 lần rồi thì nếu không muốn chọn lại thì cứ enter .

Sở dĩ bảo bạn xóa dòng span là vì dơn theo dạng giống mục #7 dễ phát sinh những ký tự lạ mà mình không muốn có, nó có thể làm lisp không chạy được.

(defun C:TL (/ k os e0 e pt pt1 chumau1)

  (defun Length1 (e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

  (defun tronso(a b) (* b (if (< (rem a b) (* 0.5 b)) (fix (/ a b 1.)) (1+ (fix (/ a b 1.))))))

  (defun dxf(id v) (cdr (assoc id (entget v))))

  

   (setq k (getvar "dimlfac")

os (getvar 'osmode))

  (setq chumau1 (car (entsel "\nChon chu mau <Enter neu khong chon lai>:")))

  (if chumau1 (setq chumau chumau1))

  

  (command "undo" "be")

  (setvar 'osmode 512)

  (vl-load-com)

  (while (setq e0 (entsel "\nChon LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE:"))  

 

    (if (vl-string-search (dxf 0 (setq e (car e0))) "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

      (progn

(setq pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object e) (last e0))

     pt1 (getpoint pt "Theo huong:"))

        (entmake (list '(0 . "TEXT") (cons 10 (polar pt (+ (angle pt pt1) (* 0.5 pi)) (* 0.2 (dxf 40 chumau))))

      (cons 7 (dxf 7 chumau))  (cons 72 0) (cons 50 (angle pt pt1))

      (cons 40 (dxf 40 chumau)) (cons 1 (rtos (tronso (* k (length1 e)) 100) 2 0)))))

      (alert "Khong the do chieu dai doi tuong nay!!")

    )

  )

  (setvar 'osmode os)

  (command "undo" "e")

  (princ)

)

[hung1608 8]

Cảm ơn bạn Tot77, Phạm Thanh Bình

Tot77 , bạn có thể cho mình hỏi cách thay đổi khoảng cách của text và đường thẳng ở đâu trong lisp được không vì mỗi bản vẽ khoảng cách của chúng nó là không giống nhau cần mình điều chỉnh

[Tot77 508]

Tôi lấy kc = 0.2 x chiều cao chữ.

Bạn muốn sửa thì tìm chỗ  (* 0.2 (dxf 40 chumau))

[hung1608 8]

Thanks bạn rất nhiều :)