Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Nhờ viết lisp chèn text số lượng lớn vào tâm đối tượng.


  • Please log in to reply
12 replies to this topic

#1 victor85

victor85

    biết lệnh stretch

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

Đã gửi 01 March 2012 - 04:52 PM

Nhờ các bác viết dùm 2 lisp chèn text sau:
Lisp1: Chèn text vào tâm đoạn thẳng (line)
+Lệnh: cen1
Chọn đối tượng đầu vào: Các line mình chọn
Chọn kiểu text cần chèn: Chọn một text nào đó được định dạnh sẵn trong bản vẽ để làm style cho text chuẩn bị chèn.
+ Kết quả là tạo ra các text được chèn vào các midpoint của các line mình đã chọn với nội dung của text chèn chính là độ dài line mình chọn (được làm chẵn đến hàng số nguyên).

Lisp2: Chèn text vào tâm hình chữ nhật (rectang)
+Lệnh: cen2
Chọn đối tượng đầu vào: Các hình chữ nhật (rectang) mình chọn
Chọn kiểu text cần chèn: Chọn một text nào đó được định dạnh sẵn trong bản vẽ để làm style cho text chuẩn bị chèn.
+ Kết quả là tạo ra các text được chèn vào các điểm tâm của các hình chữ nhật (rectang) mình đã chọn với nội dung của text chèn chính là Diện tích của hình chữ nhật mình chọn (được làm chẵn đến hàng số nguyên).

Ý tưởng của mình là sử dụng Acad làm công cụ trực quan hóa một số công việc tính toán khối lượng. Mình sẽ mô hình hóa các khối lượng công việc cần tính thành line hoặc rectang đưa về dạng chẵn đơn vị trong acad với các tỷ lệ tương ứng. Sau đó mình sẽ sử dụng nó để tính toán và chèn kết quả.
Mong các bác xuống tay giúp mình với nhé!
Hình minh họa:

Hình đã gửi
  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 01 March 2012 - 08:37 PM

Nhờ các bác viết dùm 2 lisp chèn text sau:
Lisp1: Chèn text vào tâm đoạn thẳng (line)
+Lệnh: cen1
Chọn đối tượng đầu vào: Các line mình chọn
Chọn kiểu text cần chèn: Chọn một text nào đó được định dạnh sẵn trong bản vẽ để làm style cho text chuẩn bị chèn.
+ Kết quả là tạo ra các text được chèn vào các midpoint của các line mình đã chọn với nội dung của text chèn chính là độ dài line mình chọn (được làm chẵn đến hàng số nguyên).
Lisp2: Chèn text vào tâm hình chữ nhật (rectang)
+Lệnh: cen2
Chọn đối tượng đầu vào: Các hình chữ nhật (rectang) mình chọn
Chọn kiểu text cần chèn: Chọn một text nào đó được định dạnh sẵn trong bản vẽ để làm style cho text chuẩn bị chèn.
+ Kết quả là tạo ra các text được chèn vào các điểm tâm của các hình chữ nhật (rectang) mình đã chọn với nội dung của text chèn chính là Diện tích của hình chữ nhật mình chọn (được làm chẵn đến hàng số nguyên).
Ý tưởng của mình là sử dụng Acad làm công cụ trực quan hóa một số công việc tính toán khối lượng. Mình sẽ mô hình hóa các khối lượng công việc cần tính thành line hoặc rectang đưa về dạng chẵn đơn vị trong acad với các tỷ lệ tương ứng. Sau đó mình sẽ sử dụng nó để tính toán và chèn kết quả.
Mong các bác xuống tay giúp mình với nhé!

Đây bạn!

;Doan Van Ha - CADViet.com - Ngay 01-03-2012
;Muc dich: Ghi text chieu dai hoac dien tich vao giua doi tuong.
;----- Lay chieu dai
(defun C:HA1()
(command "undo" "be")
(vl-load-com)
(setq ent (car (entsel "\nChon Text chuan: ")))
(princ "\nChon cac duong thang de lay chieu dai...")
(setq ss (ssget '((0 . "LINE"))))
(setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
(setq i 0)
(repeat (length objlst)
(setq obj (nth i objlst)
i (1+ i)
cd (vla-get-Length obj)
pg (vlax-curve-getPointAtDist obj (* cd 0.5)))
(entmake (list (cons 0 "TEXT") (cons 10 pg) (assoc 7 (entget ent)) (assoc 40 (entget ent)) (cons 1 (rtos cd 2 0)))))
(command "undo" "end")
(princ))
;----- Lay dien tich
(defun C:HA2()
(command "undo" "be")
(vl-load-com)
(setq ent (car (entsel "\nChon Text chuan: ")))
(princ "\nChon cac hinh chu nhat de lay dien tich...")
(setq ss (ssget '((-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>") (-4 . "AND>"))))
(setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
(setq i 0)
(repeat (length objlst)
(setq obj (nth i objlst)
i (1+ i)
dt (vla-get-Area obj)
pg (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion (list obj))) 'Centroid))
(entdel (entlast))
(entmake (list (cons 0 "TEXT") (cons 10 pg) (assoc 7 (entget ent)) (assoc 40 (entget ent)) (cons 1 (rtos dt 2 0)))))
(command "undo" "end")
(princ))

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 01 March 2012 - 11:18 PM

Hoặc 2 lệnh trong 1 :

(defun c:ist(/ tmp ins)
(grtext -1 "Free from Cadviet @Ketxu")
(vl-load-com)
(command "undo" "be")
(prompt "\nSelect template Text :")
(setq tmp (vlax-ename->vla-object (ssname (ssget ":S" (list (cons 0 "*TEXT"))) 0))
ins (vlax-3d-point (vlax-get tmp 'InsertionPoint))
)
(prompt "\nSelect all entity to insert text :")
(ssget (list (cons 0 "*LINE")))
(vlax-for item (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-move
(vla-copy tmp)
ins
(vlax-3d-point
((lambda(x / p1 p2)
(vla-getboundingbox x 'p1 'p2)
(mapcar '(lambda (a B) (* 0.5 (+ a B)))
(vlax-safearray->list p1) (vlax-safearray->list p2))
) item)
)
)
(vla-put-TextString
(vlax-ename->vla-object (entlast))
(rtos
(cond ((= (vla-get-ObjectName item) "AcDbLine")(vla-get-Length item))
((zerop (vla-get-Area item))(vla-get-Length item))
(T (vla-get-Area item))
)
2 0)
)
)
(command "undo" "en")
)

  • 2

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


#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 02 March 2012 - 09:51 AM

Trong tr­ường hợp này nên dùng FIELD

(defun c:test(/ ss tmau mid p1 p2)
(setq i -1)
(if (setq ss (ssget '((0 . "*LINE"))))
(progn
(setq tmau (vla-copy (vlax-ename->vla-object (car (entsel "Chon Text mau :")))))
(vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'p1 'p2)
(vla-move (setq tmau (vla-copy tmau))
(vla-get-insertionpoint tmau)
(vlax-3d-point (mapcar '(lambda (a B) (* 0.5 (+ a B))) (vlax-safearray->list p1) (vlax-safearray->list p2)))
)
(vla-put-textstring tmau (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-objectid e) ) ">%)."
(if (vlax-property-available-p e 'area) "Area" "Length")
" \\f \"%lu2%pr0\">%"))

)
)
)
)

  • 2

#5 thienha.haui

thienha.haui

    biết vẽ line

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

Đã gửi 23 February 2014 - 09:16 PM


Trong tr­ường hợp này nên dùng FIELD

(defun c:test(/ ss tmau mid p1 p2)
  (setq i -1)
  (if (setq ss (ssget '((0 . "*LINE"))))
    (progn
      (setq tmau (vla-copy (vlax-ename->vla-object (car (entsel "Chon Text mau :")))))
      (vlax-for e (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-getboundingbox e 'p1 'p2)
(vla-move (setq tmau (vla-copy tmau))
   (vla-get-insertionpoint tmau)
    (vlax-3d-point (mapcar  '(lambda (a <img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/cool.png' class='bbc_emoticon' alt='B)' /> (* 0.5 (+ a <img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/cool.png' class='bbc_emoticon' alt='B)' />)) (vlax-safearray->list p1) (vlax-safearray->list p2)))
)      
(vla-put-textstring  tmau (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-objectid e) ) ">%)."
(if (vlax-property-available-p e 'area) "Area" "Length")
" \\f \"%lu2%pr0\">%"))
 
 	)
    )
  )
)

lisp của anh rất hay.a có thể sửa các số hạng trong kết quả dc làm tròn thanh m ko ạ

vd  8344=4111+4233  ==> 8.5= 4.2+4.3

mong a giúp


  • 0

#6 thienha.haui

thienha.haui

    biết vẽ line

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

Đã gửi 23 February 2014 - 09:19 PM

Đây bạn!

;Doan Van Ha - CADViet.com - Ngay 01-03-2012
;Muc dich: Ghi text chieu dai hoac dien tich vao giua doi tuong.
;----- Lay chieu dai
(defun C:HA1()
(command "undo" "be")
(vl-load-com)
(setq ent (car (entsel "\nChon Text chuan: ")))
(princ "\nChon cac duong thang de lay chieu dai...")
(setq ss (ssget '((0 . "LINE"))))
(setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
(setq i 0)
(repeat (length objlst)
  (setq obj (nth i objlst)
        	i (1+ i)
        	cd (vla-get-Length obj)
        	pg (vlax-curve-getPointAtDist obj (* cd 0.5)))
  (entmake (list (cons 0 "TEXT") (cons 10 pg) (assoc 7 (entget ent)) (assoc 40 (entget ent)) (cons 1 (rtos cd 2 0)))))
(command "undo" "end")
(princ))
;----- Lay dien tich
(defun C:HA2()
(command "undo" "be")
(vl-load-com)
(setq ent (car (entsel "\nChon Text chuan: ")))
(princ "\nChon cac hinh chu nhat de lay dien tich...")
(setq ss (ssget '((-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "<OR") (90 . 4) (90 . 5) (-4 . "OR>") (-4 . "AND>"))))
(setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))))
(setq i 0)
(repeat (length objlst)
  (setq obj (nth i objlst)
        	i (1+ i)
        	dt (vla-get-Area obj)
        	pg (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion (list obj))) 'Centroid))
  (entdel (entlast))
  (entmake (list (cons 0 "TEXT") (cons 10 pg) (assoc 7 (entget ent)) (assoc 40 (entget ent)) (cons 1 (rtos dt 2 0)))))
(command "undo" "end")
(princ))

a hà có thể sửa giúp e giá trị trên làm tròn tới m dc ko.vd 2345 ==> 2.4

mong a giúp đỡ


  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 23 February 2014 - 09:44 PM

a hà có thể sửa giúp e giá trị trên làm tròn tới m dc ko.vd 2345 ==> 2.4

mong a giúp đỡ

Tất nhiên là được, với điều kiện bạn viết câu đúng chính tả.


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 thienha.haui

thienha.haui

    biết vẽ line

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

Đã gửi 23 February 2014 - 09:51 PM

Tất nhiên là được, với điều kiện bạn viết câu đúng chính tả.

vâng.a sửa giúp e với ạ.e cảm ơn a


  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 23 February 2014 - 09:54 PM

vâng.a sửa giúp e với ạ.e cảm ơn a

Câu vâng.a sửa giúp e với ạ.e cảm ơn a vẫn chưa đúng chính tả.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 thienha.haui

thienha.haui

    biết vẽ line

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

Đã gửi 23 February 2014 - 09:59 PM

Câu vâng.a sửa giúp e với ạ.e cảm ơn a vẫn chưa đúng chính tả.

vậy thì thôi.e nhờ cao thủ khác.đâu phải chỉ mình a biết,bó tay với con người này


  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5454 Bài viết
Điểm đánh giá: 2626 (tuyệt vời)

Đã gửi 24 February 2014 - 08:19 AM

Buồn cho nền giáo dục VN vì môn chính tả không được quan tâm lắm.

Lisp sửa cho bạn đây.

http://www.cadviet.c...029_ha1_ha2.lsp


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 HoaVien

HoaVien

    biết vẽ arc

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

Đã gửi 24 February 2014 - 08:22 AM

vậy thì thôi.e nhờ cao thủ khác.đâu phải chỉ mình a biết,bó tay với con người này

Hi, tương lai sẽ còn pótay với nhiều người.

 

vote cho HA post #7.


  • 0

#13 thienha.haui

thienha.haui

    biết vẽ line

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

Đã gửi 24 February 2014 - 09:59 AM

Buồn cho nền giáo dục VN vì môn chính tả không được quan tâm lắm.

Lisp sửa cho bạn đây.

http://www.cadviet.c...029_ha1_ha2.lsp

thanks.a có thể sửa nốt cho e cái lisp test của anh TUE_NV ở trên dc không ạ. công thức khi tính tổng cũng được đổi ra m như của a ạ.


  • 0