Đến nội dung


Hình ảnh
- - - - -

Xin Trợ Giúp Về Lisp Ghi Độ Dài Đường Thẳng Ra Block Att


  • Please log in to reply
15 replies to this topic

#1 hmt

hmt

    biết lệnh scale

  • Members
  • PipPipPip
  • 146 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 August 2015 - 10:38 AM

chào mọi người . hiện e có 1 vấn đề xin nhờ mọi người giúp đỡ. Đó là e cần ghi giá trị của các đoạn pline, line,spline gán vào 1 thông số trong block Att. do có rất nhiều các đoạn như vậy nên việc edit tay từng block là rất nhiều. ko biết có thể có 1 lisp làm đc như vậy hay k. Cụ thể như sau.

-Gõ lệnh 'GG'" pick vào đoạn thẳng lisp sẽ đề xuất chọn Block att muốn ghi dữ liệu chiều dài. sau đó pick vào block att thì chiều dài đoạn đó được ghi vào dữ liệu "L" kia.

  + Với giá trị chiều dài được ghi vào là số nguyên, làm tròn lên khi chiều dài đoạn thẳng co giá trị đo thực là dạng :  x,5..., làm tròn xuống với giá trị đo thực: x,4...

file bản vẽ minh họa đây ạ:

http://www.cadviet.c.../48377_vidu.dwg

Cảm ơn rất nhiều :)


  • -2

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 26 August 2015 - 11:29 AM

Code cái này chắc phút mốt, nên các bạn chịu khó chờ các bác trên 4room xíu ha


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 26 August 2015 - 11:40 AM

Muốn thử sức với cái này mà không Down file được :) (Công ty em bị IT chặn mạng nên mong anh em thông cảm)

Bạn gởi File dwg vào mail này mình Code thử xem sao

Gmail : transon89xd@gmail.com


  • 0

#4 anti lazy

anti lazy

    biết lệnh erase

  • Members
  • PipPipPip
  • 107 Bài viết
Điểm đánh giá: 27 (tàm tạm)

Đã gửi 26 August 2015 - 12:48 PM

Trên cadviet

-Lisp lấy chiều dài có hàng vạn

-Lisp block Att có hàng trăm

Trong 6 năm qua, nếu mỗi quý bỏ ra 1 ngày để học thì có thể viết lisp xử từng em.

Nếu intelligent hơn (không phải intelligent tự phong) thì có thể xử hàng loạt (tot77 đã có viết lisp tương tự)

Các cao thủ hầu như đã chán, chỉ còn nhạc sĩ Tr.CongSon là tích cực.

Tuy nhiên nếu cứ cho cá hoài thì chẳng có ai muốn học câu cả, vì vậy nhạc sĩ Tr.CongSon nếu giúp sớm là hại cho các mem lazy.

 

Tôi nghĩ là cadviet lập ra 1 box lisp có thu phí, phí này dùng để làm từ thiện hay việc gì khác như là giảm học phí để khuyến khích việc học tập.

Còn ai muốn free thì hãy chờ 1 thời gian nào đó vd khoảng 1 tuần, muốn download free từ các site thì cũng chờ 30s đó thôi.


  • 1

#5 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 26 August 2015 - 01:16 PM

Trên cadviet

-Lisp lấy chiều dài có hàng vạn

-Lisp block Att có hàng trăm

Trong 6 năm qua, nếu mỗi quý bỏ ra 1 ngày để học thì có thể viết líp xử từng em.

Nếu intelligent hơn (không phải intelligent tự phong) thì có thể xử hàng loạt (tot77 đã có viết lisp tương tự)

Các cao thủ hầu như đã chán, chỉ còn nhạc sĩ Tr.CongSon là tích cực.

Tuy nhiên nếu cứ cho cá hoài thì chẳng có ai muốn học câu cả, vì vậy nhạc sĩ Tr.CongSon nếu giúp sớm là hại cho các mem lazy.

 

Tôi nghĩ là cadviet lập ra 1 box lisp có thu phí, phí này dùng để làm từ thiện hay việc gì khác như là giảm học phí để khuyến khích việc học tập.

Còn ai muốn free thì hãy chờ 1 thời gian nào đó vd khoảng 1 tuần, muốn download free từ các site thì cũng chờ 30s đó thôi.

 

Nhạc sĩ Tr.Công Sơn "trở về với cát bui " rồi a ơi :)

Em chỉ là "nhạc lẻ" thôi ^^

Biết là học sẽ được nhưng họ còn học nhiều cái khác mà a ,đâu phải chỉ 1 mình cái Lisp đâu a :) 

Vả lại,thấy yêu cầu nên cũng muốn viết cho "lên tay" tí thôi mà :)

 

Đoạn màu xanh: Hình như các cao thủ "rửa tay gác kiếm" hết rồi hay sao ý,  ít thấy bình luận và viết code như hồi xưa nữa :) 


  • 1

#6 hmt

hmt

    biết lệnh scale

  • Members
  • PipPipPip
  • 146 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 August 2015 - 02:40 PM

Trên cadviet

-Lisp lấy chiều dài có hàng vạn

-Lisp block Att có hàng trăm

Trong 6 năm qua, nếu mỗi quý bỏ ra 1 ngày để học thì có thể viết líp xử từng em.

Nếu intelligent hơn (không phải intelligent tự phong) thì có thể xử hàng loạt (tot77 đã có viết lisp tương tự)

Các cao thủ hầu như đã chán, chỉ còn nhạc sĩ Tr.CongSon là tích cực.

Tuy nhiên nếu cứ cho cá hoài thì chẳng có ai muốn học câu cả, vì vậy nhạc sĩ Tr.CongSon nếu giúp sớm là hại cho các mem lazy.

 

Tôi nghĩ là cadviet lập ra 1 box lisp có thu phí, phí này dùng để làm từ thiện hay việc gì khác như là giảm học phí để khuyến khích việc học tập.

Còn ai muốn free thì hãy chờ 1 thời gian nào đó vd khoảng 1 tuần, muốn download free từ các site thì cũng chờ 30s đó thôi.

:D chào bác, thú thực thì e cũng ko có thời gian nhiều tìm hiểu e tham gia cadviet cũng lâu 6 năm như bác nói. Nhưng cũng k thường xuyên lên được nhiều,Mặc dù ngày trc cũng down 1 bộ trên cadviet về đọc, nhưng rồi bẵng đi bận quá đến h ko tìm hiểu dc. Đến bây h phải nói là mình ko nhớ nổi định nghĩa về cú pháp chứ đừng nói việc lập trình :D. Phải nói là ai cũng lên mạng nhiều , ai cũng lang thang ở các diễn đàn tìm kiếm, nhận dc sự giúp đỡ là niềm vinh hạnh. và giúp đỡ lại ng khác cũng là niềm vinh hạnh. Ở đời không cho ai không cái gì. ko đi đâu mà thiệt cả :D, bản thân cũng từng quản trị 1 diễn đàn, rồi làm getlink cái thời mà bỏ tiền túi ra để giúp mọi ng download 1 cách dễ dàng phi lợi nhuận , bù lại mình cũng dc sự trợ giúp khi cần của các member trong khả năng của họ.

- Mục yêu cầu lisp của cadviet lập ra thiết nghĩ để phục vụ cho mục đích trợ giúp đối với member. Vậy trong này có 2 loại hình trợ giúp free và trợ giúp có phí. Kết cấu của cadviet không có mục niêm yết giá vì 4rum chưa phải là thương mại hóa. Đối với các yêu cầu của member ai cảm thấy giúp đc free thì giúp, ai cảm thấy cần trả phí thì chỉ cần pm 1 dòng định giá là xong. Member nào cũng luôn vui lòng chi trả nếu họ thực sự cần và hợp lý. :D. Thử hỏi nếu 1 ngày không còn những thằng như mình vào 4rum đặt 1 vấn đề thì lấy ai hâm nóng 4rum, rồi lấy đâu ra các bài toán khó cho dân lập trình thử tay nghề.. Trả phí hay không trả phí là tùy thuộc ở người giúp đỡ member. Xin chân thành cảm ơn bác và sẽ hậu tạ :D  Tr.CongSon đã nhiệt tình giúp đỡ e. e đã gửi mail cho bác. mong bác sớm hồi âm, . Thanks all.


  • -3

#7 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 26 August 2015 - 05:04 PM

Tr.CongSon đã nhiệt tình giúp đỡ e. e đã gửi mail cho bác. mong bác sớm hồi âm, . Thanks all.

 

Đã Code xong cho anh rồi đây :)

Anh dùng xem sao nhé ^^

;;;------------------------------
;;;-----by MENZI ENGINEERING ----
(defun SetAtt (obj lst / attval)
(mapcar '(lambda (att)
(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))
(vla-put-TextString att attval)
)
)
(vlax-invoke obj 'GetAttributes)
)
(vla-update obj)
)
;;;------------------------------
(defun TS:select (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Line,Pline,SPline \U+0111\U+1EC3 l\U+1EA5y chi\U+1EC1u d\U+00E0i :"))
(cond
((= 7 (getvar 'errno))
(princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i.")
)
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"*LINE"
)
(progn (setq ent (car ent))
nil
)
(princ
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i LINE,PLINE,SPLINE."
)
)
)
)
)
)
ent
)
;;;-------------------------------
(defun GetLen (ent / len)
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (>= len 0)
(fix (+ len 0.5))
(fix (- len 0.5))
)
)
;;;-------------------------------
(defun GetDxf (n elist) (cdr (assoc n elist)))
;;;-------------------------------
(defun c:GG (/ *error* blkatt ent len)
(vl-load-com)
(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN")
(defun *error* (msg)
(if ent
(redraw ent 4)
)
(if (not (wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(while (setq ent (TS:select))
(redraw ent 3)
(setq Len (itoa (GetLen ent)))
(if (and (setq BlkATT (car (entsel "\nChon Block ATT:")))
(wcmatch (GetDxf 0 (entget BlkATT)) "INSERT")
(= (GetDxf 66 (entget BlkATT)) 1)
)
(SetAtt (vlax-ename->Vla-Object BlkATT) (list (cons "CHIEUDAI" Len)))
(alert
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block ATTribute."
)
)
(redraw ent 4)
)
(princ)
)

 

Em viết Lisp mà được người khác khen và Tick Thanks (nút xanh) là em thấy vui rồi :) :) :)

Hơn nữa viết nhiều mới mau lên tay được nên a yên tâm,vì quan điểm của e là : giúp người=giúp ta mà :)

Thôi,hết giờ làm rồi,ra làm ly bia cho nó mát  mát ruột đã .hehe

Hẹn gặp lại sau !

Chào thân ái !


  • 2

#8 anti lazy

anti lazy

    biết lệnh erase

  • Members
  • PipPipPip
  • 107 Bài viết
Điểm đánh giá: 27 (tàm tạm)

Đã gửi 26 August 2015 - 05:58 PM

Nhạc sĩ Tr.Công Sơn "trở về với cát bui " rồi a ơi :)

Em chỉ là "nhạc lẻ" thôi ^^

Biết là học sẽ được nhưng họ còn học nhiều cái khác mà a ,đâu phải chỉ 1 mình cái Lisp đâu a :)

Vả lại,thấy yêu cầu nên cũng muốn viết cho "lên tay" tí thôi mà :)

 

Đoạn màu xanh: Hình như các cao thủ "rửa tay gác kiếm" hết rồi hay sao ý,  ít thấy bình luận và viết code như hồi xưa nữa :)

Nhạc sĩ Trịnh Công Sơn thì đã trở về cát bụi, còn nhạc sĩ Tr.CongSon thì vừa học lisp, vừa viết lisp từ thiện.

Các cao thủ vẫn còn theo dõi cadviet, bằng chứng là các câu hỏi ở mục  Hỏi về Lisp (thuật toán, ý tưởng, coding,...) luôn có nhiều câu trả lời và bình luận sớm của nhiều cao thủ như Doan Van Ha, Tue_NV, ketxu, gia_bach

Các cao thủ chắc đang hưởng ứng: TP HCM kêu gọi 'không cho tiền người ăn xin' http://vnexpress.net...in-3124234.html

Nhưng tôi tin là các cao thủ sẽ sẵn lòng viết lisp free cho box lisp có thu phí (nếu có)để có kinh phí cho cadviet phát triển

Lợi ích: sẽ có nhiều người tham gia học lisp


  • 1

#9 hmt

hmt

    biết lệnh scale

  • Members
  • PipPipPip
  • 146 Bài viết
Điểm đánh giá: -11 (hơi kém)

Đã gửi 26 August 2015 - 11:49 PM

:) Cảm ơn bác nhạc sĩ tr.CongSon, lisp của bác dùng rất tốt :) xin phép hậu tạ bác , bác inbox cho e sdt hoặc tk với nhé :D .

Khả năng với yêu cầu nhỏ của mình là quá dễ và ko bõ công code và cũng chẳng học hỏi đc gì từ cái đề bài của mình ra, bên cạnh đó còn bận nhiều việc thì hẳn là cũng chẳng buồn viết , nhường chỗ lại cho 1 ng khác như a ketxu đã pm ở trên. Như bác anti lazy nói chắc chắn các cao thủ cũng sẽ giúp trong box lisp thu phí(nếu có) đây cũng dễ hiểu. có trả phí thì con ng ta mới có động lực vào hào hứng làm việc :) e hoàn toàn tán thành việc lập đc box này, tiến độ sẽ đc đẩy nhanh hơn. kể cả cung và cầu. Từng là mod cho 1 web it xây dựng nhưng vẫn mua các phần mềm nhỏ lẻ của chính các admin đó bán trên trang chủ chứ ko xin xỏ,đó cũng là xứng đáng cho công sức của 1 lập trình viên.

   UBND tpHCM thực hiện việc không cho tiền người ăn xin,vậy ở diễn đàn này có khá nhiều ng ăn xin, và khởi đầu của 1 diễn đàn mới chính là nhờ những người ăn xin này mới có thể phát triển được như ngày hôm nay.
:) e vẫn xin sự trợ giúp của cadviet nhưng mỗi topic không hề có chữ " chỉ thích free" . Member không phải ăn mày, member sẵn sàng chi trả cho những gì xứng đáng nằm trong khả năng của họ. Nếu có mục lisp trả phí ko chỉ e nhiều member sẽ post bài trong đó. Còn chưa có thì member chỉ biết post ở mục autolisp. 


  • -2

#10 vuonghung018

vuonghung018

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 10 September 2016 - 03:40 PM

Cho mình hỏi nếu lấy thập phân sau dấu , 1 hoặc 2, 3 số thì ntn?

Thanks!

Đã Code xong cho anh rồi đây :)

Anh dùng xem sao nhé ^^

;;;------------------------------
;;;-----by MENZI ENGINEERING ----
(defun SetAtt (obj lst / attval)
(mapcar '(lambda (att)
(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))
(vla-put-TextString att attval)
)
)
(vlax-invoke obj 'GetAttributes)
)
(vla-update obj)
)
;;;------------------------------
(defun TS:select (/ ent)
(while
(progn
(setvar 'errno 0)
(setq ent (entsel "\nCh\U+1ECDn Line,Pline,SPline \U+0111\U+1EC3 l\U+1EA5y chi\U+1EC1u d\U+00E0i :"))
(cond
((= 7 (getvar 'errno))
(princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i.")
)
((= 'ename (type (car ent)))
(if (wcmatch (cdr (assoc 0 (entget (car ent))))
"*LINE"
)
(progn (setq ent (car ent))
nil
)
(princ
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i LINE,PLINE,SPLINE."
)
)
)
)
)
)
ent
)
;;;-------------------------------
(defun GetLen (ent / len)
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (>= len 0)
(fix (+ len 0.5))
(fix (- len 0.5))
)
)
;;;-------------------------------
(defun GetDxf (n elist) (cdr (assoc n elist)))
;;;-------------------------------
(defun c:GG (/ *error* blkatt ent len)
(vl-load-com)
(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN")
(defun *error* (msg)
(if ent
(redraw ent 4)
)
(if (not (wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(while (setq ent (TS:select))
(redraw ent 3)
(setq Len (itoa (GetLen ent)))
(if (and (setq BlkATT (car (entsel "\nChon Block ATT:")))
(wcmatch (GetDxf 0 (entget BlkATT)) "INSERT")
(= (GetDxf 66 (entget BlkATT)) 1)
)
(SetAtt (vlax-ename->Vla-Object BlkATT) (list (cons "CHIEUDAI" Len)))
(alert
"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block ATTribute."
)
)
(redraw ent 4)
)
(princ)
)

 

Em viết Lisp mà được người khác khen và Tick Thanks (nút xanh) là em thấy vui rồi :) :) :)

Hơn nữa viết nhiều mới mau lên tay được nên a yên tâm,vì quan điểm của e là : giúp người=giúp ta mà :)

Thôi,hết giờ làm rồi,ra làm ly bia cho nó mát  mát ruột đã .hehe

Hẹn gặp lại sau !

Chào thân ái !


  • 0

#11 vuonghung018

vuonghung018

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 September 2016 - 11:51 AM

có ai giúp tôi lấy số thập phân của  lisp này không?

sdt: 0901.529.327


  • 0

#12 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 12 September 2016 - 12:27 PM

Tôi mạn phép sửa code của bác Trịnh Công Sơn cho bạn vuonghung108 nhé! 

 

;;;------------------------------

;;;-----by MENZI ENGINEERING ----

(defun SetAtt (obj lst / attval)

(mapcar '(lambda (att)

(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))

(vla-put-TextString att attval)

)

)

(vlax-invoke obj 'GetAttributes)

)

(vla-update obj)

)

;;;------------------------------

(defun TS:select (/ ent)

(while

(progn

(setvar 'errno 0)

(setq ent (entsel "\nCh\U+1ECDn Line,Pline,SPline \U+0111\U+1EC3 l\U+1EA5y chi\U+1EC1u d\U+00E0i :"))

(cond

((= 7 (getvar 'errno))

(princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i.")

)

((= 'ename (type (car ent)))

(if (wcmatch (cdr (assoc 0 (entget (car ent))))

"*LINE"

)

(progn (setq ent (car ent))

nil

)

(princ

"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i LINE,PLINE,SPLINE."

)

)

)

)

)

)

ent

)

;;;-------------------------------

(defun GetLen (ent / len)

(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))

)

;;;-------------------------------

(defun GetDxf (n elist) (cdr (assoc n elist)))

;;;-------------------------------

(defun c:GG (/ *error* blkatt ent len)

(vl-load-com)

(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN")

(defun *error* (msg)

(if ent

(redraw ent 4)

)

(if (not (wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))

(princ (strcat "\n** Error: " msg " **"))

)

(princ)

)

(while (setq ent (TS:select))

(redraw ent 3)

(setq Len (rtos (GetLen ent) 2 2))

(if (and (setq BlkATT (car (entsel "\nChon Block ATT:")))

(wcmatch (GetDxf 0 (entget BlkATT)) "INSERT")

(= (GetDxf 66 (entget BlkATT)) 1)

)

(SetAtt (vlax-ename->Vla-Object BlkATT) (list (cons "CHIEUDAI" Len)))

(alert

"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block ATTribute."

)

)

(redraw ent 4)

)

(princ)

)

 

Tôi mặc định 2 số thập phân. Bạn có thể thay đổi tùy ý trong hàm (rtos (GetLen ent) 2 2) ở trên.

VD: Muốn kết quả la 3 sô thập phân thì sửa nó lại thành (rtos (GetLen ent) 2 3)


  • 2

#13 vuonghung018

vuonghung018

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 15 September 2016 - 02:19 PM

Tôi mạn phép sửa code của bác Trịnh Công Sơn cho bạn vuonghung108 nhé! 

 

;;;------------------------------

;;;-----by MENZI ENGINEERING ----

(defun SetAtt (obj lst / attval)

(mapcar '(lambda (att)

(if (setq attval (cdr (assoc (vla-get-TagString att) lst)))

(vla-put-TextString att attval)

)

)

(vlax-invoke obj 'GetAttributes)

)

(vla-update obj)

)

;;;------------------------------

(defun TS:select (/ ent)

(while

(progn

(setvar 'errno 0)

(setq ent (entsel "\nCh\U+1ECDn Line,Pline,SPline \U+0111\U+1EC3 l\U+1EA5y chi\U+1EC1u d\U+00E0i :"))

(cond

((= 7 (getvar 'errno))

(princ "\nCh\U+1ECDn l\U+1ED7i.Vui l\U+00F2ng l\U+1EA1i.")

)

((= 'ename (type (car ent)))

(if (wcmatch (cdr (assoc 0 (entget (car ent))))

"*LINE"

)

(progn (setq ent (car ent))

nil

)

(princ

"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i LINE,PLINE,SPLINE."

)

)

)

)

)

)

ent

)

;;;-------------------------------

(defun GetLen (ent / len)

(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))

)

;;;-------------------------------

(defun GetDxf (n elist) (cdr (assoc n elist)))

;;;-------------------------------

(defun c:GG (/ *error* blkatt ent len)

(vl-load-com)

(setvar "Modemacro" "@ Tr\U+1EA7n C\U+00F4ng S\U+01A1n _ XDDD & CN")

(defun *error* (msg)

(if ent

(redraw ent 4)

)

(if (not (wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))

(princ (strcat "\n** Error: " msg " **"))

)

(princ)

)

(while (setq ent (TS:select))

(redraw ent 3)

(setq Len (rtos (GetLen ent) 2 2))

(if (and (setq BlkATT (car (entsel "\nChon Block ATT:")))

(wcmatch (GetDxf 0 (entget BlkATT)) "INSERT")

(= (GetDxf 66 (entget BlkATT)) 1)

)

(SetAtt (vlax-ename->Vla-Object BlkATT) (list (cons "CHIEUDAI" Len)))

(alert

"\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng ch\U+1ECDn kh\U+00F4ng ph\U+1EA3i Block ATTribute."

)

)

(redraw ent 4)

)

(princ)

)

 

Tôi mặc định 2 số thập phân. Bạn có thể thay đổi tùy ý trong hàm (rtos (GetLen ent) 2 2) ở trên.

VD: Muốn kết quả la 3 sô thập phân thì sửa nó lại thành (rtos (GetLen ent) 2 3)

Dear hainguyen2014:

Rất cảm ơn bạn đã edit cho tôi. Tôi dã dùng và thấy nó chỉ thêm 2,3 số "0" đằng sau, không thể hiện được số lr 1~9. bây giở làm thế nào.

VD: số thực tế của nó là 7.35 nhưng nó chỉ trả về kết quả 7.00 thôi


  • 0

#14 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 15 September 2016 - 03:05 PM

Có lẽ bạn tự sửa lại Lisp cũ nên vậy.

Bạn tải Lisp mà tôi đã sửa và đính kèm về rồi Load để chạy nhé.

Nếu tự sửa lại thì bạn phải xóa bỏ đoạn sau nữa: 

 

(if (>= len 0)

(fix (+ len 0.5))

(fix (- len 0.5))

)


  • 0

#15 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 15 September 2016 - 03:16 PM

Dùng cái này đỡ phải sửa:

(defun c:tt  (/ att ent len ss)
 (setvar 'DIMZIN 0)
 (and (setq ss (ssget "_+.:S:E" '((0 . "*LINE"))))
      (setq ent (ssname ss 0))
      (not (redraw ent 3))
      (setq att (car (nentsel "\nPick Att: ")))
      (eq (cdr (assoc 0 (entget att))) "ATTRIB")
      (setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
      (not (vla-put-textstring (vlax-ename->vla-object att) (rtos len 2
2)))
      (redraw ent 4))
 (princ))

*** S​ố chữ số thập phân nằm ở: (rtos len 2 2), màu đỏ.


  • 1

#16 vuonghung018

vuonghung018

    biết pan

  • Members
  • Pip
  • 6 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 15 September 2016 - 04:02 PM

CẢM ƠN SƯ PHỤ NHIỀU.

GOOD!


  • 0