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

tạo đối tượng text nằm trong vùng hatch

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

2 phút trước, Doan Nguyen Van đã nói:

Sửa theo Lisp của bác DUY không biết thế này đúng ý thớt chưa ?

 

ezgif.com-crop.gif

Bạn cho mình hỏi Lisp này muốn sửa giá trị hiển thị diện tích chỉ lấy hai số sau dấu chấm và sửa dấu chấm thành dấu phẩy thì sửa ở đâu bạn? VD: 123.4567 thành 123,45

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
5 phút trước, tranducanh đã nói:

Bạn cho mình hỏi Lisp này muốn sửa giá trị hiển thị diện tích chỉ lấy hai số sau dấu chấm và sửa dấu chấm thành dấu phẩy thì sửa ở đâu bạn? VD: 123.4567 thành 123,45

Hiện đang lấy theo UNIT bản vẽ, bạn đánh lệnh UN tùy chỉnh số số ) sau dấu phẩy là đc 

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
15 phút trước, Doan Nguyen Van đã nói:

Hiện đang lấy theo UNIT bản vẽ, bạn đánh lệnh UN tùy chỉnh số số ) sau dấu phẩy là đc 

Cảm ơn bạn! Mình làm được số hiển thị phía sau rồi bạn. Còn chuyển dấu chấm thành dấu phẩy thì sao hả bạn?

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
3 phút trước, tranducanh đã nói:

Cảm ơn bạn! Mình làm được số hiển thị phía sau rồi bạn. Còn chuyển dấu chấm thành dấu phẩy thì sao hả bạn?

Bạn dùng lệnh FIND để sửa nhé

25 phút trước, divine kai đã nói:

cảm ơn anh DOAN nhiều...

(alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)

;TEN LENH
(defun C:ii ()
  (alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)
  )

(vl-load-com)

;HATCH TO TEXT
(defun C:h2t ( / AREA ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
  (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
   	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
  (while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
  (setq lst (list))
  (foreach ent2 (acet-ss-to-list ss)
    (setq obj (vlax-ename->vla-object ent2))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
    (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (rtos area 2 (getvar "LUPREC")) (car (boundingbox obj))))))
    )
    	(command "UNDO" "E")
	(command "UNDO" "1")
  (foreach lst1 lst
	  (maketext (car lst1) (cadr lst1) (caddr lst1))
	  ) ) (progn
(setq obj (vlax-ename->vla-object ent))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
(maketext (cdr (assoc 8 (entget ent))) (rtos area 2 (getvar "LUPREC")) (car (boundingbox obj)))
))
    )
    
  (print)
  )
(defun C:h2l ( / ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
    (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
 	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
	(while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
	(Setq lst (list))
	       (foreach ent2 (acet-ss-to-list ss)
		 (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (car (boundingbox (vlax-ename->vla-object ent2)))))))
		 )
	(command "UNDO" "E")
	(command "UNDO" "1")
	(foreach lst1 lst
	  (maketext (car lst1) (car lst1) (cadr lst1))
	  )
	) (maketext (cdr (assoc 8 (entget ent))) (cdr (assoc 8 (entget ent))) (car (boundingbox (vlax-ename->vla-object ent))))
      ))
	
    
  (print)
  )

(defun boundingbox (obj / a b lst lst1)
  (if
    (and
      (vlax-method-applicable-p obj 'getboundingbox)
      (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
      (setq lst (mapcar 'vlax-safearray->list (list a b)))
      )
    (setq lst1 (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
		       '((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
		       )
	  lst1 (append (list (list (/ (+ (car (car lst1)) (car (caddr lst1))) 2.) (/ (+ (cadr (car lst1)) (cadr (caddr lst1))) 2.))) lst1)
	  )
    )
  )
(defun maketext (lay noidung point / lay point)
(entmakex (list
		(cons 0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons 8 lay)
		(cons 1 noidung)
		(cons 7 (getvar "TEXTSTYLE"))
		(cons 10 point)
		(cons 11 point)
		(cons 40 (/ (getvar "VIEWSIZE") 100))
		(cons 72 4)
		))
  )

 

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
1 phút trước, Doan Nguyen Van đã nói:

Bạn dùng lệnh FIND để sửa nhé

  • ii_h2t_h2l.lsp
    lisp help
  •  

(alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)

;TEN LENH
(defun C:ii ()
  (alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)
  )

(vl-load-com)

;HATCH TO TEXT
(defun C:h2t ( / AREA ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
  (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
   	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
  (while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
  (setq lst (list))
  (foreach ent2 (acet-ss-to-list ss)
    (setq obj (vlax-ename->vla-object ent2))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
    (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (rtos area 2 (getvar "LUPREC")) (car (boundingbox obj))))))
    )
    	(command "UNDO" "E")
	(command "UNDO" "1")
  (foreach lst1 lst
	  (maketext (car lst1) (cadr lst1) (caddr lst1))
	  ) ) (progn
(setq obj (vlax-ename->vla-object ent))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
(maketext (cdr (assoc 8 (entget ent))) (rtos area 2 (getvar "LUPREC")) (car (boundingbox obj)))
))
    )
    
  (print)
  )
(defun C:h2l ( / ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
    (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
 	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
	(while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
	(Setq lst (list))
	       (foreach ent2 (acet-ss-to-list ss)
		 (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (car (boundingbox (vlax-ename->vla-object ent2)))))))
		 )
	(command "UNDO" "E")
	(command "UNDO" "1")
	(foreach lst1 lst
	  (maketext (car lst1) (car lst1) (cadr lst1))
	  )
	) (maketext (cdr (assoc 8 (entget ent))) (cdr (assoc 8 (entget ent))) (car (boundingbox (vlax-ename->vla-object ent))))
      ))
	
    
  (print)
  )

(defun boundingbox (obj / a b lst lst1)
  (if
    (and
      (vlax-method-applicable-p obj 'getboundingbox)
      (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
      (setq lst (mapcar 'vlax-safearray->list (list a b)))
      )
    (setq lst1 (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
		       '((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
		       )
	  lst1 (append (list (list (/ (+ (car (car lst1)) (car (caddr lst1))) 2.) (/ (+ (cadr (car lst1)) (cadr (caddr lst1))) 2.))) lst1)
	  )
    )
  )
(defun maketext (lay noidung point / lay point)
(entmakex (list
		(cons 0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons 8 lay)
		(cons 1 noidung)
		(cons 7 (getvar "TEXTSTYLE"))
		(cons 10 point)
		(cons 11 point)
		(cons 40 (/ (getvar "VIEWSIZE") 100))
		(cons 72 4)
		))
  )

 

Ok, cảm ơn bạn rất nhiều!

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
6 phút trước, Doan Nguyen Van đã nói:

Bạn dùng lệnh FIND để sửa nhé


(alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)

;TEN LENH
(defun C:ii ()
  (alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)
  )

(vl-load-com)

;HATCH TO TEXT
(defun C:h2t ( / AREA ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
  (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
   	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
  (while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
  (setq lst (list))
  (foreach ent2 (acet-ss-to-list ss)
    (setq obj (vlax-ename->vla-object ent2))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
    (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (rtos area 2 (getvar "LUPREC")) (car (boundingbox obj))))))
    )
    	(command "UNDO" "E")
	(command "UNDO" "1")
  (foreach lst1 lst
	  (maketext (car lst1) (cadr lst1) (caddr lst1))
	  ) ) (progn
(setq obj (vlax-ename->vla-object ent))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
(maketext (cdr (assoc 8 (entget ent))) (rtos area 2 (getvar "LUPREC")) (car (boundingbox obj)))
))
    )
    
  (print)
  )
(defun C:h2l ( / ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
    (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
 	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
	(while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
	(Setq lst (list))
	       (foreach ent2 (acet-ss-to-list ss)
		 (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (car (boundingbox (vlax-ename->vla-object ent2)))))))
		 )
	(command "UNDO" "E")
	(command "UNDO" "1")
	(foreach lst1 lst
	  (maketext (car lst1) (car lst1) (cadr lst1))
	  )
	) (maketext (cdr (assoc 8 (entget ent))) (cdr (assoc 8 (entget ent))) (car (boundingbox (vlax-ename->vla-object ent))))
      ))
	
    
  (print)
  )

(defun boundingbox (obj / a b lst lst1)
  (if
    (and
      (vlax-method-applicable-p obj 'getboundingbox)
      (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
      (setq lst (mapcar 'vlax-safearray->list (list a b)))
      )
    (setq lst1 (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
		       '((caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr))
		       )
	  lst1 (append (list (list (/ (+ (car (car lst1)) (car (caddr lst1))) 2.) (/ (+ (cadr (car lst1)) (cadr (caddr lst1))) 2.))) lst1)
	  )
    )
  )
(defun maketext (lay noidung point / lay point)
(entmakex (list
		(cons 0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons 8 lay)
		(cons 1 noidung)
		(cons 7 (getvar "TEXTSTYLE"))
		(cons 10 point)
		(cons 11 point)
		(cons 40 (/ (getvar "VIEWSIZE") 100))
		(cons 72 4)
		))
  )

 

image.thumb.png.a7c86d127be5c0fb58e02370cd5caaa3.png

còn những trường hợp như thế này bắt buộc phải sửa tay đúng không anh?

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
19 phút trước, divine kai đã nói:

 

còn những trường hợp như thế này bắt buộc phải sửa tay đúng không anh?

Trường hợp này cũng giải quyết được thôi, nhưng chắc bạn muốn sửa tay hơn, dễ thì sửa giúp bạn nhưng TH đặc biệt thì cần nhiều thời gian để làm, mà chẳng ai muốn bỏ thời gian để làm free nhưng cái hại não cả....

@Doan Van Ha cháu dính nhiều rồi bác ạ :'D 

  • Like 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
1 phút trước, Doan Nguyen Van đã nói:

Trường hợp này cũng giải quyết được thôi, nhưng chắc bạn muốn sửa tay hơn, dễ thì sửa giúp bạn nhưng TH đặc biệt thì cần nhiều thời gian để làm, mà chẳng ai muốn bỏ thời gian để làm free nhưng cái hại não cả....

@Doan Van Ha cháu dính nhiều rồi bác ạ :'D 

dạ em cũng biết nó hơi phức tạp nên tốt hơn hết để em sửa tay luôn =))

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

Tham khảo

giải quyết trên 80% các vùng lõm.

@divine kai là sv thực tập mà được giao nhiều bài toán phức tạp, nếu cty nào tuyển dụng bạn chắc tinh giản biên chế kha khá đấy.

  • 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
1 giờ} trướ}c, ndtnv đã nói:

Tham khảo

giải quyết trên 80% các vùng lõm.

@divine kai là sv thực tập mà được giao nhiều bài toán phức tạp, nếu cty nào tuyển dụng bạn chắc tinh giản biên chế kha khá đấy.

Cảm ơn bạn nhé !

1 giờ} trướ}c, divine kai đã nói:

dạ em cũng biết nó hơi phức tạp nên tốt hơn hết để em sửa tay luôn =))

Mình đã sửa lại chỗ đặt text tại trọng tâm từ lisp bác @ndtnv, nhưng sao cảm thấy sai sai (ví dụ text trong hcn lại ko ở trọng tâm), nhưng dù sao thì text đã nằm trong hatch, kể cả hatch lồi hatch lõm.

Lệnh tách hatch thì mình gửi bạn 1 lisp riêng biệt, chứ viết như bác @Doan Nguyen Van thì dài quá.

 

HPS - Tach Hatch.lsp

Hatch to Text.lsp

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
6 phút trước, Duong Nhat Duy đã nói:

Cảm ơn bạn nhé !

Mình đã sửa lại chỗ đặt text tại trọng tâm từ lisp bác @ndtnv, nhưng sao cảm thấy sai sai (ví dụ text trong hcn lại ko ở trọng tâm), nhưng dù sao thì text đã nằm trong hatch, kể cả hatch lồi hatch lõm.

Lệnh tách hatch thì mình gửi bạn 1 lisp riêng biệt, chứ viết như bác @Doan Nguyen Van thì dài quá.

 

HPS - Tach Hatch.lsp

Hatch to Text.lsp

image.png.1fa9d30937f9af75779e8682c0fd0e4e.png

lisp thứ 2 nó báo lỗi như thế này anh

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
5 giờ trước, divine kai đã nói:

image.png.1fa9d30937f9af75779e8682c0fd0e4e.png

lisp thứ 2 nó báo lỗi như thế này anh

Thôi sửa nốt cho bạn.

Cảm ơn hàm của bác @ndtnv



;TEN LENH
(defun C:ii ()
  (alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)
  )

(vl-load-com)

;HATCH TO TEXT
(defun C:h2t ( / AREA ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
  (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
   	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
  (while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
  (setq lst (list))
  (foreach ent2 (acet-ss-to-list ss)
    (setq obj (vlax-ename->vla-object ent2))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
    (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (rtos area 2 (getvar "LUPREC"))  (_cen ent2)))))
    )
    	(command "UNDO" "E")
	(command "UNDO" "1")
  (foreach lst1 lst
	  (maketext (car lst1) (cadr lst1) (caddr lst1))
	  ) ) (progn
(setq obj (vlax-ename->vla-object ent))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
(maketext (cdr (assoc 8 (entget ent))) (rtos area 2 (getvar "LUPREC")) (_cen ent)  )
))
    )
    
  (print)
  )
(defun C:h2l ( / ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
    (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
 	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
	(while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
	(Setq lst (list))
	       (foreach ent2 (acet-ss-to-list ss)
		 (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2)))  (_cen ent2)))))
		 )
	(command "UNDO" "E")
	(command "UNDO" "1")
	(foreach lst1 lst
	  (maketext (car lst1) (car lst1) (cadr lst1))
	  )
	) (maketext (cdr (assoc 8 (entget ent))) (cdr (assoc 8 (entget ent))) (_cen ent))
      ))
	
    
  (print)
  )
(defun _cen (v / p1 p2 p u entl ssp lstp pl)
        (vla-getboundingbox  (vlax-ename->vla-object v) 'p1 'p2)
        (setq p (mapcar '* (mapcar '+ (vlax-safearray->list p1) (vlax-safearray->list p2)) '(0.5 0.5 0.5)))
    (setq u (entmakex (list '(0 . "LINE") (cons 10 p)(cons 11 (polar p (/ pi 2) 1)))))
  (setq entl (entlast))
  (vl-cmdf "_-HATCHEDIT" (ssadd v)  "B" "P" "Y" )
  (setq ssp (list))
  (while (setq entl (entnext entl)) (setq ssp (append ssp (list entl))))
  (setq lstp (list))
  (mapcar '(lambda (pl) (setq    p    (vlax-invoke (vlax-ename->vla-object pl) 'IntersectWith (vlax-ename->vla-object u) 2)    )
	     (entdel pl)
	     (while (and (car p) (cadr p) (caddr p))
	     (setq lstp (append lstp (list (list (Car p) (cadr p) (caddr p)) ) ))
	       (setq p (cdddr p)))
	       ) ssp)  
    (entdel u)
  (setq lstp (vl-sort lstp '(lambda (x y) (> (cadr x) (cadr y)))))
  (acet-geom-midpoint (car lstp) (cadr lstp))
)
(defun maketext (lay noidung point / lay point)
(entmakex (list
		(cons 0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons 8 lay)
		(cons 1 noidung)
		(cons 7 (getvar "TEXTSTYLE"))
		(cons 10 point)
		(cons 11 point)
		(cons 40 (getvar "TEXTSIZE"))
		(cons 72 4)
		))
  )

 

  • Like 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
38 phút trước, Doan Nguyen Van đã nói:

Thôi sửa nốt cho bạn.

Cảm ơn hàm của bác @ndtnv



;TEN LENH
(defun C:ii ()
  (alert (strcat "LISP Hatch to Text"
	       "\nNguoi viet: 3Duy"
	       "\nLenh thuc hien:"
	       "\n        H2T - Dien tich"
	       "\n        H2L - Ten layer"
	       )
)
  )

(vl-load-com)

;HATCH TO TEXT
(defun C:h2t ( / AREA ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
  (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
   	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
  (while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
  (setq lst (list))
  (foreach ent2 (acet-ss-to-list ss)
    (setq obj (vlax-ename->vla-object ent2))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
    (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2))) (rtos area 2 (getvar "LUPREC"))  (_cen ent2)))))
    )
    	(command "UNDO" "E")
	(command "UNDO" "1")
  (foreach lst1 lst
	  (maketext (car lst1) (cadr lst1) (caddr lst1))
	  ) ) (progn
(setq obj (vlax-ename->vla-object ent))
    (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () (setq area (vlax-get obj 'area))))))
      (setq area 0.00)
      (setq area (vlax-get obj 'area))
      )
(maketext (cdr (assoc 8 (entget ent))) (rtos area 2 (getvar "LUPREC")) (_cen ent)  )
))
    )
    
  (print)
  )
(defun C:h2l ( / ELST OBJ)
  (setq elst (acet-ss-to-list (ssget (list (cons 0 "HATCH")))))
    (foreach ent elst
    (if (> (vla-get-numberofloops (vlax-ename->vla-object ent)) 1) (progn
 	(setq entl (entlast))
	(command "UNDO" "BE")
	(vl-cmdf "_-HATCHEDIT" (ssadd ent) "H" "")
	(setq ss (ssadd ent))
	(while (setq entl (entnext entl))
	  (setq ss (ssadd entl ss)) )
	(Setq lst (list))
	       (foreach ent2 (acet-ss-to-list ss)
		 (setq lst (append lst (list (list (cdr (assoc 8 (entget ent2)))  (_cen ent2)))))
		 )
	(command "UNDO" "E")
	(command "UNDO" "1")
	(foreach lst1 lst
	  (maketext (car lst1) (car lst1) (cadr lst1))
	  )
	) (maketext (cdr (assoc 8 (entget ent))) (cdr (assoc 8 (entget ent))) (_cen ent))
      ))
	
    
  (print)
  )
(defun _cen (v / p1 p2 p u entl ssp lstp pl)
        (vla-getboundingbox  (vlax-ename->vla-object v) 'p1 'p2)
        (setq p (mapcar '* (mapcar '+ (vlax-safearray->list p1) (vlax-safearray->list p2)) '(0.5 0.5 0.5)))
    (setq u (entmakex (list '(0 . "LINE") (cons 10 p)(cons 11 (polar p (/ pi 2) 1)))))
  (setq entl (entlast))
  (vl-cmdf "_-HATCHEDIT" (ssadd v)  "B" "P" "Y" )
  (setq ssp (list))
  (while (setq entl (entnext entl)) (setq ssp (append ssp (list entl))))
  (setq lstp (list))
  (mapcar '(lambda (pl) (setq    p    (vlax-invoke (vlax-ename->vla-object pl) 'IntersectWith (vlax-ename->vla-object u) 2)    )
	     (entdel pl)
	     (while (and (car p) (cadr p) (caddr p))
	     (setq lstp (append lstp (list (list (Car p) (cadr p) (caddr p)) ) ))
	       (setq p (cdddr p)))
	       ) ssp)  
    (entdel u)
  (setq lstp (vl-sort lstp '(lambda (x y) (> (cadr x) (cadr y)))))
  (acet-geom-midpoint (car lstp) (cadr lstp))
)
(defun maketext (lay noidung point / lay point)
(entmakex (list
		(cons 0 "TEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbText")
		(cons 8 lay)
		(cons 1 noidung)
		(cons 7 (getvar "TEXTSTYLE"))
		(cons 10 point)
		(cons 11 point)
		(cons 40 (getvar "TEXTSIZE"))
		(cons 72 4)
		))
  )

 

Lisp cũ mình thấy số hiển thị theo Dimstyle hiện hữu. Lisp bạn vừa sửa hình nó mặc định số kiểu gì mà bé lắm bạn?

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ào lúc 26/9/2019 tại 17:26, tranducanh đã nói:

Lisp cũ mình thấy số hiển thị theo Dimstyle hiện hữu. Lisp bạn vừa sửa hình nó mặc định số kiểu gì mà bé lắm bạn?

Chữ mình lấy theo tỉ lệ view trên màn hình của bạn, muốn to bạn view rộng ra, rồi dùng lệnh bình thường.

Cỡ chữ để vậy cho linh hoạt, để mấy ông quy hoạch ko kêu ca chữ to hay mấy ông kiến trúc bảo chữ nhỏ ấy mà.

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ào lúc 28/9/2019 tại 11:47, Duong Nhat Duy đã nói:

Chữ mình lấy theo tỉ lệ view trên màn hình của bạn, muốn to bạn view rộng ra, rồi dùng lệnh bình thường.

Cỡ chữ để vậy cho linh hoạt, để mấy ông quy hoạch ko kêu ca chữ to hay mấy ông kiến trúc bảo chữ nhỏ ấy mà.

Cảm ơn bạn, vì bình thường mình thường thấy xuất ra chữ kích thước theo Dimstyle nên mình kiểm soát được bạn. Cái này làm kiểu gì mình cũng thấy nó tí ti, zoom lên tìm đọ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
16 giờ trước, tranducanh đã nói:

Cảm ơn bạn, vì bình thường mình thường thấy xuất ra chữ kích thước theo Dimstyle nên mình kiểm soát được bạn. Cái này làm kiểu gì mình cũng thấy nó tí ti, zoom lên tìm đọa :'(

Ah mình nhầm bạn ơi, lisp của Doan Nguyen Van modify lại thì chữ nhỏ là phải, bạn sửa (cons 40 (getvar "TEXTSIZE")) thành (cons 40 (/ (getvar "VIEWSIZE") 100))

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ào lúc 1/10/2019 tại 09:09, Duong Nhat Duy đã nói:

Ah mình nhầm bạn ơi, lisp của Doan Nguyen Van modify lại thì chữ nhỏ là phải, bạn sửa (cons 40 (getvar "TEXTSIZE")) thành (cons 40 (/ (getvar "VIEWSIZE") 100))

Mình làm được rồi, cảm ơn bạn nhiều nhé!

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

×