Nối các điểm chèn text thành những đoạn thẳng theo yêu cầu

Tháng 7 20, 2007

Trên màn hình tôi có các đối tượng là text có ghi các mã điểm (mã điểm có thể định dạng theo: 001, 002, 003 hoặc 1), 2), 3) . v. .v.) xin các anh giúp tôi tiện ích : khi chọn các text ghi các mã điểm này, lọc các text trong cùng một layer, hỏi mã điểm cần nối, sau đó nối các điểm chèn của text thành những đoạn thẳng theo thứ tự của người sử dụng nhập vào (ví dụ: người sử dụng type tại dòng command : nối điểm 001,002,003 ta sẽ vẽ được 1 đoạn thẳng mà điểm bắt đầu là điểm chèn của text thứ nhất, nối điểm 2 và kết thúc tại điểm chèn của text thứ 3 ) chân thành cảm ơn các anh.

Tháng 7 20, 2007

Trên màn hình tôi có các đối tượng là text có ghi các mã điểm (mã điểm có thể định dạng theo: 001, 002, 003 hoặc 1), 2), 3) . v. .v.) xin các anh giúp tôi tiện ích : khi chọn các text ghi các mã điểm này, lọc các text trong cùng một layer, hỏi mã điểm cần nối, sau đó nối các điểm chèn của text thành những đoạn thẳng theo thứ tự của người sử dụng nhập vào (ví dụ: người sử dụng type tại dòng command : nối điểm 001,002,003 ta sẽ vẽ được 1 đoạn thẳng mà điểm bắt đầu là điểm chèn của text thứ nhất, nối điểm 2 và kết thúc tại điểm chèn của text thứ 3 ) chân thành cảm ơn các anh.

Tên lệnh là NOITEXT.

Lệnh sẽ yêu cầu người sử dụng chọn các text.

Sau đó sẽ so sánh giá trị của các text và nối line vào điểm chèn các text theo thứ tự tăng dần (hoặc giảm dần).

(defun c:noitext ()
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (cond
      (ss (sslength ss))
      (t 0)
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )
 (defun luuos ()
   (setq
     HOANH_OSMODE   (getvar "OSMODE")
     HOANH_AUTOSNAP (getvar "AUTOSNAP")
   )
 )
 (defun traos ()
   (if	HOANH_OSMODE
     (setvar "OSMODE" HOANH_OSMODE)
   )
   (if	HOANH_AUTOSNAP
     (setvar "AUTOSNAP" HOANH_AUTOSNAP)
   )
 )
 (defun sosanhtext (ent1 ent2)
   (> (cdr (assoc 1 (entget ent1)))
      (cdr (assoc 1 (entget ent2)))
   )
 )
 (princ "\nNoitext © 2007 - CADViet.com")
 (setq
   ss	   (ssget '((0 . "TEXT")))
   lstent (ss2ent ss)
   lstent (vl-sort lstent 'sosanhtext)
 )
 (luuos)
 (setvar "osmode" 0)
 (command ".line")
 (foreach pp lstent
   (setq p (trans (cdr (assoc 10 (entget pp))) 0 1))
   (command p)
 )
 (command "")
 (traos)
 (princ)
)
(vl-load-com)
(princ "\nNoiText - chuong trinh noi cac diem chen cua text bang cac line")
(princ "\n© 2007 - CADViet.com")
(princ)

Tháng 7 20, 2007

Tên lệnh là NOITEXT.

Lệnh sẽ yêu cầu người sử dụng chọn các text.

Sau đó sẽ so sánh giá trị của các text và nối line vào điểm chèn các text theo thứ tự tăng dần (hoặc giảm dần).

(defun c:noitext ()
 (defun ss2ent	(ss / sodt index lstent)
   (setq
     sodt  (cond
      (ss (sslength ss))
      (t 0)
    )
     index 0
   )
   (repeat sodt
     (setq ent	   (ssname ss index)
    index  (1+ index)
    lstent (cons ent lstent)
     )
   )
   (reverse lstent)
 )
 (defun luuos ()
   (setq
     HOANH_OSMODE   (getvar "OSMODE")
     HOANH_AUTOSNAP (getvar "AUTOSNAP")
   )
 )
 (defun traos ()
   (if	HOANH_OSMODE
     (setvar "OSMODE" HOANH_OSMODE)
   )
   (if	HOANH_AUTOSNAP
     (setvar "AUTOSNAP" HOANH_AUTOSNAP)
   )
 )
 (defun sosanhtext (ent1 ent2)
   (> (cdr (assoc 1 (entget ent1)))
      (cdr (assoc 1 (entget ent2)))
   )
 )
 (princ "\nNoitext © 2007 - CADViet.com")
 (setq
   ss	   (ssget '((0 . "TEXT")))
   lstent (ss2ent ss)
   lstent (vl-sort lstent 'sosanhtext)
 )
 (luuos)
 (setvar "osmode" 0)
 (command ".line")
 (foreach pp lstent
   (setq p (trans (cdr (assoc 10 (entget pp))) 0 1))
   (command p)
 )
 (command "")
 (traos)
 (princ)
)
(vl-load-com)
(princ "\nNoiText - chuong trinh noi cac diem chen cua text bang cac line")
(princ "\n© 2007 - CADViet.com")
(princ)

vô cùng khâm phục, anh Hoành viết code nhanh thật một lần nữa chân thành cảm ơn anh

Tháng 7 20, 2007

vô cùng khâm phục, anh Hoành viết code nhanh thật một lần nữa chân thành cảm ơn anh

Xin anh Hoành giúp tôi với file noitext.lsp trên, ta có thể hiệu chỉnh,nâng cấp lên nhắm mục đích xác định giới hạn các điểm nối được không? (ví dụ : tôi có tập hợp mã điểm, giờ tôi chỉ muốn nối các điểm 1,2,3,4 thành đối tượng = a, điểm 5,6,7,8 thành đối tượng = b ) Cảm ơn anh

Tháng 7 20, 2007

Và kết quả, đối tượng cuối cùng là gì?

Cái mà Vbao đặt tên là a, nó bao gồm những gì? có text không? có line không?

Tháng 7 20, 2007

Và kết quả, đối tượng cuối cùng là gì?
Cái mà Vbao đặt tên là a, nó bao gồm những gì? có text không? có line không?

xin lỗi anh Hoành do tôi diễn giải không rõ ràng, vướng mắc của tôi là trong 1 bản vẽ bình đồ có nhiều chi tiết điểm mia, tôi muốn nối các text thành các đoạn thẳng theo mã điểm (vd: có các điểm mia chi tiết: nhà 001, nhà 002, nhà 003, nhà 004, tiện ích noitext.lsp sẽ nối từ điểm 001 đến 004 bởi các đoạn thẳng, các dòng text khác không có định dạng 0xx sẽ bỏ qua)

Tháng 7 20, 2007

(defun c:noitext ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun luuos ()
(setq
HOANH_OSMODE (getvar "OSMODE")
HOANH_AUTOSNAP (getvar "AUTOSNAP")
)
)
(defun traos ()
(if HOANH_OSMODE
(setvar "OSMODE" HOANH_OSMODE)
)
(if HOANH_AUTOSNAP
(setvar "AUTOSNAP" HOANH_AUTOSNAP)
)
)
(defun sosanhtext (ent1 ent2)
(> (cdr (assoc 1 (entget ent1)))
(cdr (assoc 1 (entget ent2)))
)
)
(princ "\nNoitext © 2007 - CADViet.com")
(setq
ss (ssget '((0 . "TEXT") (1 . "###")))
lstent (ss2ent ss)
lstent (vl-sort lstent 'sosanhtext)
)
(luuos)
(setvar "osmode" 0)
(command ".line")
(foreach pp lstent
(setq p (trans (cdr (assoc 10 (entget pp))) 0 1))
(command p)
)
(command "")
(traos)
(princ)
)
(vl-load-com)
(princ "\nNoiText - chuong trinh noi cac diem chen cua text bang cac line")
(princ "\n© 2007 - CADViet.com")
(princ)

lisp này chỉ chọn các đối tượng text có 3 chữ số mà thôi!

Tháng 7 20, 2007

(defun c:noitext ()
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
(defun luuos ()
(setq
HOANH_OSMODE (getvar "OSMODE")
HOANH_AUTOSNAP (getvar "AUTOSNAP")
)
)
(defun traos ()
(if HOANH_OSMODE
(setvar "OSMODE" HOANH_OSMODE)
)
(if HOANH_AUTOSNAP
(setvar "AUTOSNAP" HOANH_AUTOSNAP)
)
)
(defun sosanhtext (ent1 ent2)
(> (cdr (assoc 1 (entget ent1)))
(cdr (assoc 1 (entget ent2)))
)
)
(princ "\nNoitext © 2007 - CADViet.com")
(setq
ss (ssget '((0 . "TEXT") (1 . "###")))
lstent (ss2ent ss)
lstent (vl-sort lstent 'sosanhtext)
)
(luuos)
(setvar "osmode" 0)
(command ".line")
(foreach pp lstent
(setq p (trans (cdr (assoc 10 (entget pp))) 0 1))
(command p)
)
(command "")
(traos)
(princ)
)
(vl-load-com)
(princ "\nNoiText - chuong trinh noi cac diem chen cua text bang cac line")
(princ "\n© 2007 - CADViet.com")
(princ)

lisp này chỉ chọn các đối tượng text có 3 chữ số mà thôi!

Tôi xin upload file yêu cầu của tôi, một lần nữa làm phiền anh Hoành xin anh giúp tôi, chân thành cảm ơn anh

http://www.cadviet.com/upfiles/madiem_1.dwg

Tháng 7 22, 2007

Tôi xin upload file yêu cầu của tôi, một lần nữa làm phiền anh Hoành xin anh giúp tôi, chân thành cảm ơn anh

http://www.cadviet.com/upfiles/madiem_1.dwg

Anh Hoành ơi giúp tôi với!!!

Tháng 7 23, 2007

Anh Hoành ơi giúp tôi với!!!

Có lẽ bác Hoành bận, để ssg hộ một tay. Đề nghị các bạn lần sau nêu yêu cầu rõ ràng hơn, càng rõ càng tốt. Điều đó giúp người lập trình có định hướng chuẩn xác ngay từ đầu, đỡ mất công sửa đi sửa lại.

Ngay cả đoạn CT dưới đây, ssg cũng không chắc là có đúng ý bạn hay không. Ví dụ: CT đọc text "001r ranh dat", nó sẽ tách ra 2 thành phần:

- Value = "001" = 1

- Code = "r ranh dat"

Value thì không có vấn đề, nhưng code là thành phần rất "nhạy cảm", nều bạn viết thừa hoặc thiếu dù chỉ 1 dấu cách, ví dụ: "r ranh dat " hoặc "r ranh dat B", chương trình sẽ xem như không cùng code và lọc bỏ.

Tóm lại, bạn phải có quy định rõ và nhất quán về code (mã điểm), cụ thể là sử dụng chính xác bao nhiêu ký tự cho code. Chẳng hạn, nếu bạn quy định 1 ký tự cho code thì (setq code (substr code 1 1)) là xong. Khi đó, chương trình sẽ hiểu:

- Code = "r"

- Các ký tự sau r: " ranh dat..." chỉ là ghi chú, không ảnh hưởng gì.

;;;----------------------------------------------------------
(defun sepT (S / i j)
(setq i 1 j 32)
(while (or (= j 32) (and (>= j 48) (<= j 57)))
         (setq j (ascii (substr S i 1)) i (1+ i))
)
(setq i (- i 2))
(list (substr S 1 i) (substr S (+ i 1) (- (strlen S) i)))
)
;;;----------------------------------------------------------
(defun valT(e) (atoi (car (sepT (cdr (assoc 1 (entget e)))))))
;;;----------------------------------------------------------
(defun codeT(e) (cadr (sepT (cdr (assoc 1 (entget e))))))
;;;----------------------------------------------------------
(defun compT(e1 e2) (>= (valT e1) (valT e2)))
;;;----------------------------------------------------------
(defun filT (ss e0 / Le e)
(setq Le nil)
(while (setq e (ssname ss 0))
   (if (and (compT e e0) (equal (codeT e) (codeT e0)))
       (setq Le (append Le (list e)))
   )
   (ssdel e SS)
)
Le
)
;;;===============================
(defun C:CJT(/ oldos ss e0 MyL e)
(setq
   oldos (getvar "osmode")
   ss (ssget '((0 . "TEXT")))
   e0 (car (entsel "\nChon text chuan: "))
   MyL (vl-sort (filT ss e0) 'compT)
)
(setvar "osmode" 0)
(command ".line")
(foreach e MyL (command (cdr (assoc 10 (entget e)))))
(command "")
(setvar "osmode" oldos)
(princ)
)
;;;===============================

Tháng 7 23, 2007

Có lẽ bác Hoành bận, để ssg hộ một tay. Đề nghị các bạn lần sau nêu yêu cầu rõ ràng hơn, càng rõ càng tốt. Điều đó giúp người lập trình có định hướng chuẩn xác ngay từ đầu, đỡ mất công sửa đi sửa lại.
Ngay cả đoạn CT dưới đây, ssg cũng không chắc là có đúng ý bạn hay không. Ví dụ: CT đọc text "001r ranh dat", nó sẽ tách ra 2 thành phần:

- Value = "001" = 1

- Code = "r ranh dat"

Value thì không có vấn đề, nhưng code là thành phần rất "nhạy cảm", nều bạn viết thừa hoặc thiếu dù chỉ 1 dấu cách, ví dụ: "r ranh dat " hoặc "r ranh dat B", chương trình sẽ xem như không cùng code và lọc bỏ.

Tóm lại, bạn phải có quy định rõ và nhất quán về code (mã điểm), cụ thể là sử dụng chính xác bao nhiêu ký tự cho code. Chẳng hạn, nếu bạn quy định 1 ký tự cho code thì (setq code (substr code 1 1)) là xong. Khi đó, chương trình sẽ hiểu:

- Code = "r"

- Các ký tự sau r: " ranh dat..." chỉ là ghi chú, không ảnh hưởng gì.
;;;----------------------------------------------------------
(defun sepT (S / i j)
(setq i 1 j 32)
(while (or (= j 32) (and (>= j 48) (<= j 57)))
         (setq j (ascii (substr S i 1)) i (1+ i))
)
(setq i (- i 2))
(list (substr S 1 i) (substr S (+ i 1) (- (strlen S) i)))
)
;;;----------------------------------------------------------
(defun valT(e) (atoi (car (sepT (cdr (assoc 1 (entget e)))))))
;;;----------------------------------------------------------
(defun codeT(e) (cadr (sepT (cdr (assoc 1 (entget e))))))
;;;----------------------------------------------------------
(defun compT(e1 e2) (>= (valT e1) (valT e2)))
;;;----------------------------------------------------------
(defun filT (ss e0 / Le e)
(setq Le nil)
(while (setq e (ssname ss 0))
   (if (and (compT e e0) (equal (codeT e) (codeT e0)))
       (setq Le (append Le (list e)))
   )
   (ssdel e SS)
)
Le
)
;;;===============================
(defun C:CJT(/ oldos ss e0 MyL e)
(setq
   oldos (getvar "osmode")
   ss (ssget '((0 . "TEXT")))
   e0 (car (entsel "\nChon text chuan: "))
   MyL (vl-sort (filT ss e0) 'compT)
)
(setvar "osmode" 0)
(command ".line")
(foreach e MyL (command (cdr (assoc 10 (entget e)))))
(command "")
(setvar "osmode" oldos)
(princ)
)
;;;===============================

xin cảm ơn anh ssg đã quan tâm, biết các anh trong diễn đàn rất bận nhưng do áp lực về tiến độ công việc nên đôi lúc tôi diễn đạt có sơ sót mong các anh lượng thứ.

như đã trình bày ở trên: tôi cần chương trình nối các đoạn thẳng theo mã điểm, trong đó mã điểm được định dạng làm 2 thành phần

- Value = "001" = 1

- Code = chỉ cần 1 ký tự đại diện và ghi liền sau value (ví dụ: r= ranh dat, n= goc nha, d= mep duong, 001r = điểm thứ nhất ranh đất, 002r = điểm thứ hai ranh đất . . . )

yêu cầu dữ liệu đầu vào:

- hỏi value cần nối

- ký tự đại diện cho mã điểm

vd: người sử dụng nhập value cần nối : 001,002,003,004, mã điểm : n

chương trình sẽ tự động nối thành các đoạn thẳng bắt đầu từ điểm 001n - 002n 003n và kết thúc tại điểm 004n, nếu tôi thay đổi mã điểm: d, chương trình tiếp tục tìm các giá trị 001d nối tiếp vào điểm 002d, 003d . . .

Từ ngày gia nhập diễn đàn, cá nhân và cả cơ quan tôi rất tâm đắc với cadviet, đây đúng là một sân chơi bổ ích, diễn đàn đã giúp cho chúng tôi nâng cao kiến thức rất nhiều, những bài post lên diễn đàn là những kinh nghiệm thực tế mà chúng tôi gặp phải, tuy nhiên đôi khi cách diễn đạt không rõ ràng mạch lạc một lần nữa mong các anh thông cảm. Chân thành cảm ơn các anh.

Tháng 7 23, 2007

Có lẽ bác Hoành bận, để ssg hộ một tay. Đề nghị các bạn lần sau nêu yêu cầu rõ ràng hơn, càng rõ càng tốt. Điều đó giúp người lập trình có định hướng chuẩn xác ngay từ đầu, đỡ mất công sửa đi sửa lại.
Ngay cả đoạn CT dưới đây, ssg cũng không chắc là có đúng ý bạn hay không. Ví dụ: CT đọc text "001r ranh dat", nó sẽ tách ra 2 thành phần:

- Value = "001" = 1

- Code = "r ranh dat"

Value thì không có vấn đề, nhưng code là thành phần rất "nhạy cảm", nều bạn viết thừa hoặc thiếu dù chỉ 1 dấu cách, ví dụ: "r ranh dat " hoặc "r ranh dat B", chương trình sẽ xem như không cùng code và lọc bỏ.

Tóm lại, bạn phải có quy định rõ và nhất quán về code (mã điểm), cụ thể là sử dụng chính xác bao nhiêu ký tự cho code. Chẳng hạn, nếu bạn quy định 1 ký tự cho code thì (setq code (substr code 1 1)) là xong. Khi đó, chương trình sẽ hiểu:

- Code = "r"

- Các ký tự sau r: " ranh dat..." chỉ là ghi chú, không ảnh hưởng gì.
;;;----------------------------------------------------------
(defun sepT (S / i j)
(setq i 1 j 32)
(while (or (= j 32) (and (>= j 48) (<= j 57)))
         (setq j (ascii (substr S i 1)) i (1+ i))
)
(setq i (- i 2))
(list (substr S 1 i) (substr S (+ i 1) (- (strlen S) i)))
)
;;;----------------------------------------------------------
(defun valT(e) (atoi (car (sepT (cdr (assoc 1 (entget e)))))))
;;;----------------------------------------------------------
(defun codeT(e) (cadr (sepT (cdr (assoc 1 (entget e))))))
;;;----------------------------------------------------------
(defun compT(e1 e2) (>= (valT e1) (valT e2)))
;;;----------------------------------------------------------
(defun filT (ss e0 / Le e)
(setq Le nil)
(while (setq e (ssname ss 0))
   (if (and (compT e e0) (equal (codeT e) (codeT e0)))
       (setq Le (append Le (list e)))
   )
   (ssdel e SS)
)
Le
)
;;;===============================
(defun C:CJT(/ oldos ss e0 MyL e)
(setq
   oldos (getvar "osmode")
   ss (ssget '((0 . "TEXT")))
   e0 (car (entsel "\nChon text chuan: "))
   MyL (vl-sort (filT ss e0) 'compT)
)
(setvar "osmode" 0)
(command ".line")
(foreach e MyL (command (cdr (assoc 10 (entget e)))))
(command "")
(setvar "osmode" oldos)
(princ)
)
;;;===============================

anh ssg ơi chạy chương trình gặp lỗi sau :

*Invalid selection*

Expects a point or Last

Chon text chuan:

; error: bad argument type: lentityp nil

tại dòng command line : Chon text chuan : phải nhập như thế nào?

xin cảm ơn anh

Tháng 7 23, 2007

xin cảm ơn anh ssg đã quan tâm, biết các anh trong diễn đàn rất bận nhưng do áp lực về tiến độ công việc nên đôi lúc tôi diễn đạt có sơ sót mong các anh lượng thứ.
như đã trình bày ở trên: tôi cần chương trình nối các đoạn thẳng theo mã điểm, trong đó mã điểm được định dạng làm 2 thành phần

- Value = "001" = 1

- Code = chỉ cần 1 ký tự đại diện và ghi liền sau value (ví dụ: r= ranh dat, n= goc nha, d= mep duong, 001r = điểm thứ nhất ranh đất, 002r = điểm thứ hai ranh đất . . . )

yêu cầu dữ liệu đầu vào:

- hỏi value cần nối

- ký tự đại diện cho mã điểm

vd: người sử dụng nhập value cần nối : 001,002,003,004, mã điểm : n

chương trình sẽ tự động nối thành các đoạn thẳng bắt đầu từ điểm 001n - 002n 003n và kết thúc tại điểm 004n, nếu tôi thay đổi mã điểm: d, chương trình tiếp tục tìm các giá trị 001d nối tiếp vào điểm 002d, 003d . . .

Từ ngày gia nhập diễn đàn, cá nhân và cả cơ quan tôi rất tâm đắc với cadviet, đây đúng là một sân chơi bổ ích, diễn đàn đã giúp cho chúng tôi nâng cao kiến thức rất nhiều, những bài post lên diễn đàn là những kinh nghiệm thực tế mà chúng tôi gặp phải, tuy nhiên đôi khi cách diễn đạt không rõ ràng mạch lạc một lần nữa mong các anh thông cảm. Chân thành cảm ơn các anh.

Ssg vẫn chưa thông lắm, có vài điểm cần hỏi thêm:

1) Nếu người dùng cần nối từ 001r đến 999r không lẽ phải nhập cả ngàn số? Ssg đề nghị chỉ nhập điểm bắt đầu và điểm kết thúc, chương trình sẽ tự tìm các điểm còn lại. Ví dụ:

- Diem bat dau: 005r

- Diem ket thuc: 123r

Chương trình sẽ tìm tất cả các điểm trên bản vẽ: 005r, 006r,..., 122r, 123r và vẽ line nối chúng lại theo đúng thứ tự.

2) Có 2 phương án nhập số liệu:

- Dùng phím nhập chuỗi "005r" và "123r"

- Dùng chuột select 2 đối tượng text "005r ranh dat" và "123r ranh dat"

Bạn thích phương án nào hơn?

Tháng 7 23, 2007

anh ssg ơi chạy chương trình gặp lỗi sau :

*Invalid selection*

Expects a point or Last

Chon text chuan:

; error: bad argument type: lentityp nil

tại dòng command line : Chon text chuan : phải nhập như thế nào?

xin cảm ơn anh

Dùng chuột select đối tượng text bạn muốn bắt đầu, chẳng hạn 002r, CT sẽ bắt đầu vẽ từ 002r, 003r đến 00nr.

Tháng 7 23, 2007

vâng hoàn toàn đồng ý với anh về cách nhập điểm ban đầu - điểm kết thúc, tôi muốn nhập giá trị từ bàn phím (tránh tình trạng Zoom Pan tìm kiếm điểm trên màn hình), mong anh giúp cho. Thanks

Tháng 7 24, 2007

CT đã sửa:

;;;----------------------------------------------------------
(defun sepT (S / i j)
(setq i 1 j 32)
(while (or (= j 32) (and (>= j 48) (<= j 57)))
         (setq j (ascii (substr S i 1)) i (1+ i))
)
(setq i (- i 2))
(list (substr S 1 i) (substr S (+ i 1) (- (strlen S) i)))
)
;;;----------------------------------------------------------
(defun valT(e) (atoi (car (sepT (cdr (assoc 1 (entget e)))))))
;;;----------------------------------------------------------
(defun codeT(e) (substr (cadr (sepT (cdr (assoc 1 (entget e))))) 1 1))
;;;----------------------------------------------------------
(defun compT(e1 e2) (<= (valT e1) (valT e2)))
;;;----------------------------------------------------------
(defun filT (ss v1 v2  C / Le e)
(setq Le nil)
(while (setq e (ssname ss 0))
   (if (and (>= (valT e) v1) (<= (valT e) v2) (equal (codeT e) C))
       (setq Le (append Le (list e)))
   )
   (ssdel e SS)
)
Le
)
;;;----------------------------------------------------------
(defun drawT(MyL / e)
   (setq oldos (getvar "osmode"))
   (setvar "osmode" 0)
   (command ".line")
   (foreach e MyL (command (cdr (assoc 10 (entget e)))))
   (command "")
   (setvar "osmode" oldos)
)
;;;================================
(defun C:CJT(/ C V1 V2 SS MyL)
(setq
   C (getstring "\nPoint-code:")
   V1 (getint "\nBegin index:")
   V2 (getint "\nEnd index:")
   SS (ssget "X" '((0 . "TEXT")))
   MyL (vl-sort (filT SS V1 V2 C) 'compT)
)
(cond
   ((not MyL) (alert "Objects not found!"))
   ((= (length MyL) 1) (alert "Only one object!"))
   ((drawT MyL))
)
(princ)
)
;;;================================

Command: cjt

Point-code:r

Begin index:2

End index:17

CT sẽ vẽ line từ điểm 002r, 003r... đến 017r. Nếu không tìm thấy, hoặc chỉ tìm thấy 1 điểm sẽ thông báo nhắc nhở.

Hy vọng lần này hợp ý bạn.

Tháng 7 24, 2007

CT đã sửa:

;;;----------------------------------------------------------
(defun sepT (S / i j)
(setq i 1 j 32)
(while (or (= j 32) (and (>= j 48) (<= j 57)))
         (setq j (ascii (substr S i 1)) i (1+ i))
)
(setq i (- i 2))
(list (substr S 1 i) (substr S (+ i 1) (- (strlen S) i)))
)
;;;----------------------------------------------------------
(defun valT(e) (atoi (car (sepT (cdr (assoc 1 (entget e)))))))
;;;----------------------------------------------------------
(defun codeT(e) (substr (cadr (sepT (cdr (assoc 1 (entget e))))) 1 1))
;;;----------------------------------------------------------
(defun compT(e1 e2) (<= (valT e1) (valT e2)))
;;;----------------------------------------------------------
(defun filT (ss v1 v2  C / Le e)
(setq Le nil)
(while (setq e (ssname ss 0))
   (if (and (>= (valT e) v1) (<= (valT e) v2) (equal (codeT e) C))
       (setq Le (append Le (list e)))
   )
   (ssdel e SS)
)
Le
)
;;;----------------------------------------------------------
(defun drawT(MyL / e)
   (setq oldos (getvar "osmode"))
   (setvar "osmode" 0)
   (command ".line")
   (foreach e MyL (command (cdr (assoc 10 (entget e)))))
   (command "")
   (setvar "osmode" oldos)
)
;;;================================
(defun C:CJT(/ C V1 V2 SS MyL)
(setq
   C (getstring "\nPoint-code:")
   V1 (getint "\nBegin index:")
   V2 (getint "\nEnd index:")
   SS (ssget "X" '((0 . "TEXT")))
   MyL (vl-sort (filT SS V1 V2 C) 'compT)
)
(cond
   ((not MyL) (alert "Objects not found!"))
   ((= (length MyL) 1) (alert "Only one object!"))
   ((drawT MyL))
)
(princ)
)
;;;================================

Command: cjt

Point-code:r

Begin index:2

End index:17

CT sẽ vẽ line từ điểm 002r, 003r... đến 017r. Nếu không tìm thấy, hoặc chỉ tìm thấy 1 điểm sẽ thông báo nhắc nhở.

Hy vọng lần này hợp ý bạn.

Cảm ơn anh ssg, anh Hoành, vướng mắc của tôi đã được giải quyết, một lần nữa xin cảm ơn diễn đàn

Tháng 8 1, 2007

Cảm ơn anh ssg, anh Hoành, vướng mắc của tôi đã được giải quyết, một lần nữa xin cảm ơn diễn đàn

Anh ssg có thể hướng dẫn giúp tôi khắc phục vì sao chương trình nối điểm trên chỉ chạy được 1 lần, lần thứ 2 thay đổi mã điểm khác gặp thông báo: "Objects not found!" cảm ơn anh.

Tháng 8 2, 2007

Anh ssg có thể hướng dẫn giúp tôi khắc phục vì sao chương trình nối điểm trên chỉ chạy được 1 lần, lần thứ 2 thay đổi mã điểm khác gặp thông báo: "Objects not found!" cảm ơn anh.

Thông báo "Objects not found!" chỉ xuất hiện khi MyL nil. Điều này chỉ xảy ra khi không có đối tượng nào thỏa mãn điều kiện:

(setq

SS (ssget "X" '((0 . "TEXT")))

MyL (vl-sort (filT SS V1 V2 C) 'compT)

)

Có thể có 2 nguyên nhân:

1) Bạn vô tình không chú ý đến chữ hoa, chữ thường. Muốn sửa chỗ này, không phân biệt chữ hoa hay chữ thường thì dùng hàm Strcase.

2) Đối tượng của bạn là MTEXT, bị loại ngay từ dòng ssget. Nếu muốn dùng cả MTEXT thì sửa như sau:

(setq

SS (ssget "X" '((0 . "TEXT,MTEXT")))

MyL (vl-sort (filT SS V1 V2 C) 'compT)

)

Tuy nhiên, giữa TEXT và MTEXT có sự khác biệt về cách lấy tọa độ chuẩn. Biểu thức lấy tọa độ chuẩn của chương trình là:

(cdr (assoc 10 (entget e)))

- Với TEXT, tọa độ chuẩn luôn luôn là điểm góc dưới bên trái của dòng text, không phụ thuộc vào thuộc tính Justify.

- Với MTEXT, tọa độ chuẩn phụ thuộc vào Justify. Nếu chỉ nhìn trên màn hình, không dùng lệnh Properties, bạn không thể biết đuợc nó Justify kiểu nào!

Theo mình, bạn chỉ nên dùng thống nhất 1 kiểu TEXT, với justify mặc định là Left cho công việc này, tránh trường hợp sai lệch tọa độ đáng tiếc.

Tháng 8 2, 2007

Thông báo "Objects not found!" chỉ xuất hiện khi MyL nil. Điều này chỉ xảy ra khi không có đối tượng nào thỏa mãn điều kiện:
(setq

SS (ssget "X" '((0 . "TEXT")))

MyL (vl-sort (filT SS V1 V2 C) 'compT)

)

Có thể có 2 nguyên nhân:

1) Bạn vô tình không chú ý đến chữ hoa, chữ thường. Muốn sửa chỗ này, không phân biệt chữ hoa hay chữ thường thì dùng hàm Strcase.

2) Đối tượng của bạn là MTEXT, bị loại ngay từ dòng ssget. Nếu muốn dùng cả MTEXT thì sửa như sau:

(setq

SS (ssget "X" '((0 . "TEXT,MTEXT")))

MyL (vl-sort (filT SS V1 V2 C) 'compT)

)

Tuy nhiên, giữa TEXT và MTEXT có sự khác biệt về cách lấy tọa độ chuẩn. Biểu thức lấy tọa độ chuẩn của chương trình là:

(cdr (assoc 10 (entget e)))

- Với TEXT, tọa độ chuẩn luôn luôn là điểm góc dưới bên trái của dòng text, không phụ thuộc vào thuộc tính Justify.

- Với MTEXT, tọa độ chuẩn phụ thuộc vào Justify. Nếu chỉ nhìn trên màn hình, không dùng lệnh Properties, bạn không thể biết đuợc nó Justify kiểu nào!

Theo mình, bạn chỉ nên dùng thống nhất 1 kiểu TEXT, với justify mặc định là Left cho công việc này, tránh trường hợp sai lệch tọa độ đáng tiếc.

Cảm ơn anh ssg

Tháng 8 10, 2007

Xin lisp nối các điểm chèn text với nội dung sau:

chọn các text cơ sở lấy thứ tự là khoảng cách giữa các điểm

chèn text

ví dụ có 3 text A, B, C

A cách B là 1

B cách C là 2

A cách C là 4

có nghĩa là A gần B hơn C

Khoảng cách giữa các điểm chèn giới hạn là bao nhiêu

sẽ được lisp hỏi khi chạy

Sau đó vẽ 1 line nối A với B với C

Tháng 8 10, 2007

tên lệnh là JPT. Lệnh sẽ yêu cầu bạn nhập 2 lần. Lần thứ nhất là select tập các đối tượng text cần nối với nhau. Lần thứ 2 là pick vào đối tượng text đầu tiên.

(defun c:jpt (/	ssp entbd index	sop tapdiemxet entdt p diemht diemnoi
      tapkq)

 (defun hoanh_newerror	(msg)
   (if	(and (/= msg "Function cancelled")
     (/= msg "quit / exit abort")
)
     (princ (strcat "\n" msg))
   )
   (done)
 )

 (defun init ()
   (setq
     HOANH_CMD	     (getvar "CMDECHO")
     HOANH_OLDERROR *error*
     *error*	     hoanh_newerror

   )
   (setvar "CMDECHO" 0)
   (command ".undo" "BE")
 )

 (defun done ()
   (command ".redraw")
   (command ".undo" "E")
   (if	HOANH_CMD
     (setvar "CMDECHO" HOANH_CMD)
   )
   (if	HOANH_OLDERROR
     (setq *error* HOANH_OLDERROR)
   )
   (princ)
 )

 (defun luuos ()
   (setq
     HOANH_OSMODE   (getvar "OSMODE")
     HOANH_AUTOSNAP (getvar "AUTOSNAP")
   )
 )
 (defun traos ()
   (if	HOANH_OSMODE
     (setvar "OSMODE" HOANH_OSMODE)
   )
   (if	HOANH_AUTOSNAP
     (setvar "AUTOSNAP" HOANH_AUTOSNAP)
   )
 )

 (defun timgannhat (p tapp / pp kq dmin)
   (setq kq nil)
   (foreach pp	tapp
     (if (or (not dmin)
      (> dmin (distance p pp))
  )
(setq dmin (distance p pp)
      kq   pp
)
     )
   )
   kq
 )
 (init)
 (princ "\nLisp noi text - © 2007, CADViet.com")
 (princ "\nHay chon text")
 (setq
   ssp	       (ssget '((0 . "TEXT")))
   entbd      (car (entsel "\nChi dinh text bat dau:"))
   index      0
   sop	       (sslength ssp)
   tapdiemxet nil
 )
 (repeat sop
   (setq entdt	     (ssname ssp index)
  index	     (1+ index)
  p	     (cdr (assoc 10 (entget entdt)))
  tapdiemxet (append tapdiemxet (list p))
   )
 )
 (setq
   diemht     (cdr (assoc 10 (entget entbd)))
   tapdiemxet (vl-remove diemht tapdiemxet)
   tapkq      (list diemht)
   diemnoi    (timgannhat diemht tapdiemxet)
 )
 (while diemnoi
   (setq
     tapdiemxet (vl-remove diemnoi tapdiemxet)
     tapkq	 (append tapkq (list diemnoi))
     diemht	 diemnoi
     diemnoi	 (timgannhat diemht tapdiemxet)
   )
 )
 (luuos)
 (setvar "osmode" 0)
 (command ".3dpoly")
 (foreach p tapkq
   (command p)
 )
 (command "")
 (traos)
 (done)
)
(princ "\nJPT - Free lisp from www.cadviet.com")
(princ)

Tháng 8 10, 2007

tên lệnh là JPT. Lệnh sẽ yêu cầu bạn nhập 2 lần. Lần thứ nhất là select tập các đối tượng text cần nối với nhau. Lần thứ 2 là pick vào đối tượng text đầu tiên.

(defun c:jpt (/	ssp entbd index	sop tapdiemxet entdt p diemht diemnoi
      tapkq)

 (defun hoanh_newerror	(msg)
   (if	(and (/= msg "Function cancelled")
     (/= msg "quit / exit abort")
)
     (princ (strcat "\n" msg))
   )
   (done)
 )

 (defun init ()
   (setq
     HOANH_CMD	     (getvar "CMDECHO")
     HOANH_OLDERROR *error*
     *error*	     hoanh_newerror

   )
   (setvar "CMDECHO" 0)
   (command ".undo" "BE")
 )

 (defun done ()
   (command ".redraw")
   (command ".undo" "E")
   (if	HOANH_CMD
     (setvar "CMDECHO" HOANH_CMD)
   )
   (if	HOANH_OLDERROR
     (setq *error* HOANH_OLDERROR)
   )
   (princ)
 )

 (defun luuos ()
   (setq
     HOANH_OSMODE   (getvar "OSMODE")
     HOANH_AUTOSNAP (getvar "AUTOSNAP")
   )
 )
 (defun traos ()
   (if	HOANH_OSMODE
     (setvar "OSMODE" HOANH_OSMODE)
   )
   (if	HOANH_AUTOSNAP
     (setvar "AUTOSNAP" HOANH_AUTOSNAP)
   )
 )

 (defun timgannhat (p tapp / pp kq dmin)
   (setq kq nil)
   (foreach pp	tapp
     (if (or (not dmin)
      (> dmin (distance p pp))
  )
(setq dmin (distance p pp)
      kq   pp
)
     )
   )
   kq
 )
 (init)
 (princ "\nLisp noi text - © 2007, CADViet.com")
 (princ "\nHay chon text")
 (setq
   ssp	       (ssget '((0 . "TEXT")))
   entbd      (car (entsel "\nChi dinh text bat dau:"))
   index      0
   sop	       (sslength ssp)
   tapdiemxet nil
 )
 (repeat sop
   (setq entdt	     (ssname ssp index)
  index	     (1+ index)
  p	     (cdr (assoc 10 (entget entdt)))
  tapdiemxet (append tapdiemxet (list p))
   )
 )
 (setq
   diemht     (cdr (assoc 10 (entget entbd)))
   tapdiemxet (vl-remove diemht tapdiemxet)
   tapkq      (list diemht)
   diemnoi    (timgannhat diemht tapdiemxet)
 )
 (while diemnoi
   (setq
     tapdiemxet (vl-remove diemnoi tapdiemxet)
     tapkq	 (append tapkq (list diemnoi))
     diemht	 diemnoi
     diemnoi	 (timgannhat diemht tapdiemxet)
   )
 )
 (luuos)
 (setvar "osmode" 0)
 (command ".3dpoly")
 (foreach p tapkq
   (command p)
 )
 (command "")
 (traos)
 (done)
)
(princ "\nJPT - Free lisp from www.cadviet.com")
(princ)

cảm ơn anh Hoành

Tháng 8 11, 2007

Xin lisp nối các điểm chèn text với nội dung sau:

chọn các text cơ sở lấy thứ tự là khoảng cách giữa các điểm

chèn text

ví dụ có 3 text A, B, C

A cách B là 1

B cách C là 2

A cách C là 4

có nghĩa là A gần B hơn C

Khoảng cách giữa các điểm chèn giới hạn là bao nhiêu

sẽ được lisp hỏi khi chạy

Sau đó vẽ 1 line nối A với B với C

Tháng 8 11, 2007

Xin lisp nối các điểm chèn text với nội dung sau:
chọn các text cơ sở lấy thứ tự là khoảng cách giữa các điểm

chèn text

ví dụ có 3 text A, B, C

A cách B là 1

B cách C là 2

A cách C là 4

có nghĩa là A gần B hơn C

Khoảng cách giữa các điểm chèn giới hạn là bao nhiêu

sẽ được lisp hỏi khi chạy

Sau đó vẽ 1 line nối A với B với C

Là lệnh JPT mà bạn?

Đăng nhập

Nối các điểm chèn text thành những đoạn thẳng theo yêu cầu

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

vbao 80

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

Nguyen Hoanh 4.663

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

vbao 80

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

vbao 80

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

Nguyen Hoanh 4.663

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

vbao 80

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

Nguyen Hoanh 4.663

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

vbao 80

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

vbao 80

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

ssg 1.102

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

vbao 80

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

vbao 80

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

ssg 1.102

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

ssg 1.102

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

vbao 80

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

ssg 1.102

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

vbao 80

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

vbao 80

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

ssg 1.102

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

vbao 80