Chuyển đến nội dung
Diễn đàn CADViet
victor85

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

Các bài được khuyến nghị

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:

 

pro.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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")
)

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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\">%"))

	)
   )
 )
)

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Đâ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 đỡ

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

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.com/upfiles/3/67029_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 ạ.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×