Lisp của bác ssg chạy tối ưu với đa giác lồi nói chung. Nhưng khi gặp đa giác lõm thì nhiều trường hợp chưa đúng. Nguồn gốc của sự bất cập này là về phương pháp offset và tìm điểm nằm trong đa giác bằng cách tìm điểm trọng tâm.

Xin được đề xuất giải thuật khác cho bài toán này. Thuật toán khá đơn giản: với mọi điểm P nằm trong đa giác, điểm nằm trong vùng rộng nhất...

Lisp của bác ssg chạy tối ưu với đa giác lồi nói chung. Nhưng khi gặp đa giác lõm thì nhiều trường hợp chưa đúng. Nguồn gốc của sự bất cập này là về phương pháp offset và tìm điểm nằm trong đa giác bằng cách tìm điểm trọng tâm.

Xin được đề xuất giải thuật khác cho bài toán này. Thuật toán khá đơn giản: với mọi điểm P nằm trong đa giác, điểm nằm trong vùng rộng nhất sẽ có khoảng cách min từ nó tới biên đa giác là max.

Thuật toán dưới đây (lệnh là T2) rà qua tất cả các đỉnh nằm trong đa giác với bước nhảy delta. Tính tất cả khoảng cách min của P tới đa giác. Tìm ra điểm P nào có giá trị này lớn nhất.

Để rà qua tất cả các điểm nằm trong đa giác, chúng ta quét 1 tia xline từ ymin của đa giác tới ymax của đa giác. Tìm các điểm giao của xline này với đa giác. Nếu số điểm giao là chẵn (tức là xline cắt đa giác tại điểm điển hình) chúng ta rà lần lượt qua các khoảng cắt nằm trong đa giác. Tính giá trị khoảng cách min từ P đến biên đa giác bằng hàm vlax-curve-getClosestPointTo.



Lisp trên sẽ chấm đỏ tại tất cả các điểm mà nó xét. Rồi vẽ một circle có tâm nằm tại điểm thỏa mãn, bán kính là khoảng cách max. Nói cách khác, chương trình sẽ vẽ một circle với bán kính lớn nhất nằm trong đa giác đã cho.

Cái này anh Duy đã viết rồi bạn.
Lisp thêm text và bớt text đó
Đây :
http://www.cadviet.com/forum/index.php?showtopic=6991

Còn đây là Lisp themdau và botdau, Tue_NV viết theo ý của bạn :
Chú ý : Nếu Text đã có dấu trừ đằng trước thì chạy Lisp Themdau sẽ không có tác dụng vì đã có dấu trừ đằng trước
Nếu Text không có dấu trừ đằng trước thì chạy Lisp botdau...

Cái này anh Duy đã viết rồi bạn.
Lisp thêm text và bớt text đó
Đây :
http://www.cadviet.com/forum/index.php?showtopic=6991

Còn đây là Lisp themdau và botdau, Tue_NV viết theo ý của bạn :
Chú ý : Nếu Text đã có dấu trừ đằng trước thì chạy Lisp Themdau sẽ không có tác dụng vì đã có dấu trừ đằng trước
Nếu Text không có dấu trừ đằng trước thì chạy Lisp botdau sẽ không có tác dụng vì Text đã là số dương (không thể bớt số)

Còn một dòng mà e loay hoay đổi các kiểu nửa tiếng mà không được, Bác nào check lỗi giúp em với ạ !
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0&#entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0&#entry115904
(defun c:noisuy(/...

Còn một dòng mà e loay hoay đổi các kiểu nửa tiếng mà không được, Bác nào check lỗi giúp em với ạ !
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0&#entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0&#entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(or *z1* (setq *z1* 10.0))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(or *z2* (setq *z2* 20.0))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(or *m* (setq *m* 20.0))
(setq m (getint (strcat "\nSo phan tu <" (rtos m 2 0) ">: "))) ;=> dong nay e chua sua duoc !
(if (not m) (setq m *m*) (setq *m* m))
;(setq m (getint (strcat "\n so phan tu " < " (itoa m) " >:"")) )
;(setq m (getint "\n So phan tu nam giua A va B "(itoa m)" : ") i 0 ) ;

(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu: <" (vl-princ-to-string cao) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :")) ;
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)

hic. lúc trước em cũng được gợi ý ITOA đó rùi, nhưng không hiểu sao lỗi. E đổi giống bác hướng dẫn nhưng mà bị lỗi ko chạy được ? chẳng hiểu vì sao. Bác xem cho em nhé

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175903&st=20&#entry175903
;; free lisp from cadviet.com
;;; this lisp was downloaded from...

hic. lúc trước em cũng được gợi ý ITOA đó rùi, nhưng không hiểu sao lỗi. E đổi giống bác hướng dẫn nhưng mà bị lỗi ko chạy được ? chẳng hiểu vì sao. Bác xem cho em nhé

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175903&st=20&#entry175903
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=175482&st=0&#entry175482
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=27632&pid=115904&st=0&#entry115904
(defun c:noisuy(/ p1 Z1 p2 Z2 p ptg Ztg dis ang Hz m cao oldos a)
;;;;copyright by Tue_NV. Contact : tue_nvcc@yahoo.com
(setq temperr *error*)
(setq *error* bloi)
;;;;;;;;;;;;;;;;;;;
(setq p1 (getpoint "\n Nhap diem P1 :") L '())
;(setq Z1 (getreal "\n Nhap cao do Z1 :"))
(or *z1* (setq *z1* 10.0))
(setq z1 (getreal (strcat "\nCao do Z1 <" (rtos *z1* 2) ">: ")))
(if (not z1) (setq z1 *z1*) (setq *z1* z1))
(setq p2 (getpoint p1 "\n Nhap diem P2 :"))
; (setq Z2 (getreal "\n Nhap cao do Z2 :"))
(or *z2* (setq *z2* 20.0))
(setq z2 (getreal (strcat "\nCao do Z2 <" (rtos *z2* 2) ">: ")))
(if (not z2) (setq z2 *z2*) (setq *z2* z2))
(setq dis (distance p1 p2)
ang (angle p1 p2))
(setq Hz (- Z1 Z2) tana (abs (/ Hz dis)))
(or *m* (setq *m* 20))
(setq m (getint (strcat "\nSo phan tu <" (itoa m) ">: ")))

(or cao (setq cao 2)) ; 10 = Khoang cach mac dinh
(setq cao (cond ((getdist (strcat "\n chieu cao chu: <" (vl-princ-to-string cao) " > :")))(cao)))
; (setq cao (getdist "\n Nhap chieu cao chu :")) ;
(Setq oldos (getvar "OSMODE"))
(SETVAR "OSMODE" 0)
(Repeat (+ m 2)
(setq p (polar p1 ang (* i (/ dis (1+ m)))))
(setq a (distance p p1))
(if (< Z1 Z2)
(if (equal (+ (distance p1 p) dis) (distance p p2) 0.000001)
(progn (setq Z (+ Z1 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z1 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (> Z1 Z2)
(if (equal (+ (distance p2 p) dis) (distance p p1) 0.000001)
(progn (setq Z (+ Z2 (* tana (- a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
(progn (setq Z (+ Z2 (* tana (+ a) )))
(setq L (append L (list (in (rtos Z 2 3) p cao (angle p1 p2)) )))
)
)
)
(command "point" p)
(setq i (1+ i))
);while
(COMMAND "LINE" P1 P2 "")
(if (> (cadr p1) (cadr p2))
(progn (mapcar '(lambda(x y)
(vla-put-textstring
(vla-get-textstring (vlax-ename->vla-object x)) y)
) L (reverse L) )))
(SETVAR "OSMODE" oldos)
(setq *error* temperr)
(princ)
)
;;;
(defun *error* (msg)
(princ "error: ")
(princ msg)
(princ)
)
;;;;;;;;;;;;;;;;
(defun bloi(errmsg)
(command "snap" "R" '(0 0 0) 0)
)
(defun in(txt p cao ang)
(while (> ang (/ pi 2))
(setq ang (- ang pi))
)
(entmakex (list(cons 0 "TEXT") (cons 1 txt) (cons 10 p) (cons 11 p) (cons 40 cao) (cons 50 ang)
(cons 72 1) (cons 73 1)
)
)
)



hic. Mà e không hiểu sao cái GETINT mình thay bằng GETREAL không được nhỉ ? e hiểu nôm na thì getreal là tập hợp mẹ của getint mà ? hức !

Mình dùng cad14 còn có express tool, không lẽ cad2002 lại không có? bạn chưa cài thôi.
code của bạn đây:

- chọn các đối tượng gồm text và các line cần xoá.
- Pick trung điểm 2 đường line chắn 2 đầu -> OK
Ngoài lề 1 chút: về bảng trắc ngang của bạn. Thông thường người ta để cao độ và khoảng cách lẻ thiết kế bên trên, cao độ tự nhiên và khoảng cách lẻ tự...

Mình dùng cad14 còn có express tool, không lẽ cad2002 lại không có? bạn chưa cài thôi.
code của bạn đây:

- chọn các đối tượng gồm text và các line cần xoá.
- Pick trung điểm 2 đường line chắn 2 đầu -> OK
Ngoài lề 1 chút: về bảng trắc ngang của bạn. Thông thường người ta để cao độ và khoảng cách lẻ thiết kế bên trên, cao độ tự nhiên và khoảng cách lẻ tự nhiên bên dưới. Bạn nên sửa lại bảng trắc ngang nova, mặc định nova nó sắp xếp bị ngược.

Chào bạn vtd_xd,
Đây là cái lisp để bạn dùng thử. Mình viết lại dựa theo cái lisp của bác Tue_NV viết để thống kê vòng tròn. Nếu có gì chưa phù hợp bạn hãy post lên.


Trong lisp này mình căn cứ vào bản vẽ bạn post và giả định là các text cần đếm của bạn nằm trên lớp "_text" và có style là "TKCK". Với các bản vẽ mà text cần phân loại không có các thuộc tính như...

Chào bạn vtd_xd,
Đây là cái lisp để bạn dùng thử. Mình viết lại dựa theo cái lisp của bác Tue_NV viết để thống kê vòng tròn. Nếu có gì chưa phù hợp bạn hãy post lên.


Trong lisp này mình căn cứ vào bản vẽ bạn post và giả định là các text cần đếm của bạn nằm trên lớp "_text" và có style là "TKCK". Với các bản vẽ mà text cần phân loại không có các thuộc tính như trên thì bạn có thể đổi lại mã trong dòng code này cho phù hợp:
(ssget (list (cons 0 "TEXT") (cons 8 "_text") (cons 7 "TKCK")))
Chúc bạn vui.

1) Bạn dùng thử chương trình này. Cung cách hoạt động của CT như sau:
- User chọn vùng cần xử lý, trong phạm vi hình chữ nhật được xác định bằng 2 điểm pick
- CT explode toàn bộ các blocks
- Explode toàn bộ các pline (thành line và arc)
- CT không split arc, circle và spline (nếu làm sẽ gãy khúc, in ra không coi được!)
- Split line thành từng segments có chiều dài do người dùng...

1) Bạn dùng thử chương trình này. Cung cách hoạt động của CT như sau:
- User chọn vùng cần xử lý, trong phạm vi hình chữ nhật được xác định bằng 2 điểm pick
- CT explode toàn bộ các blocks
- Explode toàn bộ các pline (thành line và arc)
- CT không split arc, circle và spline (nếu làm sẽ gãy khúc, in ra không coi được!)
- Split line thành từng segments có chiều dài do người dùng chọn. Lưu ý: trị số này càng nhỏ, số lượng segment càng lớn -> thời gian chạy CT lâu hơn và kích thước file cũng lớn lên theo tương ứng. Trị số trong cặp dấu móc nhọn là do CT tính và đề nghị = 1/100 khoảng cách 2 điểm pick khi user chọn vùng (nếu đồng ý chỉ Enter)
- Purge toàn bộ các block



2) Theo bạn mô tả thì đó là insert block. Bạn thử dùng lệnh adcenter (AutoCAD Design Center, bấm Ctrl+2) bao giờ chưa? Cái này đúng yêu cầu của bạn, cần gì đến lisp.

Chương trình ghi tọa độ tâm đường tròn và ghi kích thước kiểu xxxx/2 = yyy:



Có 4 lệnh:
CC, Coordinate of Circles
DD, convert Dimensions to Divided format.
XDD, make X Dimension by Divided format
YDD, make Y Dimension by Divided format

Chú ý:
Lệnh convert DD áp dụng cho mọi đối tượng dimension nhưng các lệnh make chỉ áp dụng cho dimlinear và buộc phải chia thành 2 lệnh...

Chương trình ghi tọa độ tâm đường tròn và ghi kích thước kiểu xxxx/2 = yyy:



Có 4 lệnh:
CC, Coordinate of Circles
DD, convert Dimensions to Divided format.
XDD, make X Dimension by Divided format
YDD, make Y Dimension by Divided format

Chú ý:
Lệnh convert DD áp dụng cho mọi đối tượng dimension nhưng các lệnh make chỉ áp dụng cho dimlinear và buộc phải chia thành 2 lệnh XDD và YDD. Lý do: dù có xử lý gì đi nữa, cuối cùng chương trình vẫn phải gọi lệnh dimlinear. Sau khi pick 2 điểm, người dùng có thể tùy ý chọn dim theo phương ngang hoặc thẳng đứng, cái đó nằm ngoài tầm kiểm soát của chương trình nên phải quy định rõ ràng ngay từ đầu! Đã làm đầy đủ theo ý bạn, nhưng theo quan điểm của mình, bạn cứ đánh dim bình thường, sau đó dùng DD cho tất cả các dim muốn convert. Chỉ 1 lần là OK ngay.