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

Tháng 9 26, 2019

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 ?

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

Tháng 9 26, 2019

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

anh định kèm lips ở đâu vậy anh

Mình mới sửa xong H2L, đang sửa nốt H2T rồi mới đăng

Tháng 9 26, 2019

Vừa xong, Doan Nguyen Van đã nói:

Mình mới sửa xong H2L, đang sửa nốt H2T rồi mới đăng

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

Tháng 9 26, 2019

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

Tháng 9 26, 2019

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?

Tháng 9 26, 2019

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

Tháng 9 26, 2019

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

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

ii_h2t_h2l.lsp
[✎]


(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!

Tháng 9 26, 2019

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

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?

Tháng 9 26, 2019

@Doan Nguyen Van Bị sa lầy vào vùng Vịnh rồi!

Tháng 9 26, 2019

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

Tháng 9 26, 2019

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

Tháng 9 26, 2019

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

Cảm ơn anh Doan chúc anh nhiều sức khỏe trong cv anh nhé

Tháng 9 26, 2019

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.

Tháng 9 26, 2019

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

Tháng 9 26, 2019

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

Tháng 9 26, 2019

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

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

Hic mình cũng ko rõ nữa, có thể do đoạn lisp của @ndtnv, nhờ bạn giúp mình với !

Tháng 9 26, 2019

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

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

Tháng 9 26, 2019

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?

Tháng 9 28, 2019

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

Tháng 9 30, 2019

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 :'(

Tháng 10 1, 2019

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

Tháng 10 2, 2019

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é!

Tháng 3 5, 2021

Vào lúc 25/9/2019 tại 11:16, Duong Nhat Duy đã nói:

Đây bạn, H2T hiện diện tích, H2L hiện tên layer.

Hatch to Text.lsp

Bạn ơi textstyle và chiều cao text đang lấy như thế nào vậy bạn, mình muốn sữa chiều cao text thì sửa lại như thế nào chỉ mình với

Tháng 3 5, 2021

21 phút trước, vanhuyou đã nói:

Bạn ơi textstyle và chiều cao text đang lấy như thế nào vậy bạn, mình muốn sữa chiều cao text thì sửa lại như thế nào chỉ mình với

Style bạn sửa ở đây: (getvar "TEXTSTYLE")

Cao chữ bạn sửa ở đây: (/ (getvar "VIEWSIZE") 100)

Thay hết cả cụm kể cả dấu ngoặc nhé, riêng style thì thêm "" 2 đầu nữa

Tháng 3 5, 2021

1 giờ} trướ}c, Duong Nhat Duy đã nói:

Style bạn sửa ở đây: (getvar "TEXTSTYLE")

Cao chữ bạn sửa ở đây: (/ (getvar "VIEWSIZE") 100)

Thay hết cả cụm kể cả dấu ngoặc nhé, riêng style thì thêm "" 2 đầu nữa

Cám ơn bạn :)

Đăng nhập

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

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

tranducanh 10

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

Doan Nguyen Van 489

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

divine kai 0

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

Doan Nguyen Van 489

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

tranducanh 10

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

Doan Nguyen Van 489

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

tranducanh 10

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

divine kai 0

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

Doan Van Ha 3.196

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

Doan Nguyen Van 489

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

divine kai 0

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

divine kai 0

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

ndtnv 481

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

Duong Nhat Duy 304

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

divine kai 0

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

Duong Nhat Duy 304

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

Doan Nguyen Van 489

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

tranducanh 10

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

Duong Nhat Duy 304

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

tranducanh 10