Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#321 Mr Cuong

Mr Cuong

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 03 November 2009 - 11:11 PM

Anh Nguyễn Hoang ơi Anh có thể viết giùm em 1 Lisp với nội dung sau không :
Trong bản vẽ của em có rất nhiều đường Poline. Khoảng cách giữa các điểm point không đều nhau.
Em muốn có 1 lisp như sau: Khi ta chon 1 hay nhiều đường poline thì: Tính theo chiều từ trái sang phải(theo trục X) sắp sếp lại các điểm point trên cùng 1 poline sao cho khoảng cách giữa các điểm point đều bằng nhau, các điểm point mới không được ra ngoài đường poline đó.
Rất mong anh có thể giúp em. Xin cảm ơn anh trước nha !
  • 0

#322 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 November 2009 - 05:42 AM

Anh Nguyễn Hoang ơi Anh có thể viết giùm em 1 Lisp với nội dung sau không :
Trong bản vẽ của em có rất nhiều đường Poline. Khoảng cách giữa các điểm point không đều nhau.
Em muốn có 1 lisp như sau: Khi ta chon 1 hay nhiều đường poline thì: Tính theo chiều từ trái sang phải(theo trục X) sắp sếp lại các điểm point trên cùng 1 poline sao cho khoảng cách giữa các điểm point đều bằng nhau, các điểm point mới không được ra ngoài đường poline đó.
Rất mong anh có thể giúp em. Xin cảm ơn anh trước nha !

Các point mà bạn đề cập đến phải chăng là các đỉnh Vertex của PLINE
Bạn có thể xem ở đây : Bài viết số 31 đến bài viết số 39
  • 0

#323 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 04 November 2009 - 07:44 AM

(defun c:pt()
(setq i 0 txt_pnt (ssget '((0 . "TEXT,point"))))
(command "undo" "begin")
(setq oldos (getvar "osmode"))
(command "osmode" 0)
(repeat (sslength txt_pnt)
(setq txt_pnt_ent (entget (ssname txt_pnt i)))
(if (assoc 1 txt_pnt_ent)
(progn
(setq txt_pt (cdr (assoc 10 txt_pnt_ent)) ii 0 kcmin 999999999999999999)
(while (< ii (sslength txt_pnt))
(setq txt_pnt_ent1 (entget (ssname txt_pnt ii)))
(if (assoc 1 txt_pnt_ent1) ()
(progn (setq pnt_pt (cdr(assoc 10 txt_pnt_ent1)) kci (distance txt_pt pnt_pt))
(if (< kci kcmin) (setq kcmin kci pnt_goc pnt_pt))
);progn
);if
(setq ii (+ ii 1))
);while
(command "move" (ssname txt_pnt i) "" txt_pt pnt_goc)
);progn
);if
(setq i (+ i 1))
);repeat
(setvar "osmode" oldos)
(command "undo" "end")
);defun

Chú ý:
- Khi chạy lisp này, với mỗi text lisp sẽ quyét tất cả các point để tìm point gần nhất và di chuyển text đến point đó. Chính vì thế có thể xảy ra trường hợp (rất ít xảy ra) 2 text có chung một point gần nhất, khi đó lisp sẽ di chuyển chúng trùng với nhau dẫn đến có thể một số point bị lạc mất text cao độ. bạn sử dụng chú ý một chút là OK.
- Tên lệnh bạn có thể tự đổi cho phù hợp với nhu cầu.
- Vì viết nhanh nên mình chỉ quan tâm đến hiệu quả, không quan tâm đến chất lượng nên lisp này nói chung là không hay lắm dưới con mắt người lập trình, vài chỗ cách làm hơi củ chuối nhưng với người sử dụng thì OK không vấn đề gì. hi vọng đúng ý bạn. :tongue2:

Bạn xem lại giúp, load lisp, gõ lệnh, báo lỗi "; error: too many arguments"
Mình dùng Cad 2004
  • 0

#324 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 November 2009 - 08:11 AM

Bạn xem lại giúp, load lisp, gõ lệnh, báo lỗi "; error: too many arguments"
Mình dùng Cad 2004

Bạn nhấn nút Reply bài viết số 340 hoặc nhấn nút Edit bài viết số 350 của bạn (nằm ngay trên bài viết này)-> chép hết code về chạy nhé
Cheers
  • 2

#325 Trần Diệu Nhân

Trần Diệu Nhân

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 04 November 2009 - 09:38 AM

Anh Tue_NV! Giúp e cái lisp bố trí cột vào lưới với ạ!
File đính kèm đây a: http://www.mediafire...lvw3inzdwm/lisp dat ki hieu va bo tri cot.dwg
  • 0

#326 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 04 November 2009 - 11:36 AM

Bạn nhấn nút Reply bài viết số 340 hoặc nhấn nút Edit bài viết số 350 của bạn (nằm ngay trên bài viết này)-> chép hết code về chạy nhé
Cheers

Lỗi này lạ nhỉ. hình như lỗi này là do trình duyệt mà các bác dùng góp phần tạo ra chứ không hẳn là do cadviet. trong suốt thời gian qua và hiện giờ em không hề bị dính lỗi này, vẫn có thể copy code trực tiếp về dùng bình thường. em dùng Opera 10.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#327 dlongkts

dlongkts

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 04 November 2009 - 01:23 PM

Bạn Tuệ ơi! Bạn có lisp nào copy các số dạng 1+; 1-... sang một vị trí khác thành 2+; 2-... không?
Mình đang vẽ đường dốc cho ô tô mà
  • 0

#328 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 November 2009 - 01:58 PM

Bạn Tuệ ơi! Bạn có lisp nào copy các số dạng 1+; 1-... sang một vị trí khác thành 2+; 2-... không?
Mình đang vẽ đường dốc cho ô tô mà

Bạn hãy đọc thật kỹ bài viết số 4 của Tue_NV. Nó sẽ giúp bạn làm điều đó
Bài viết đó ở đây : Bai viet so 4
  • 0

#329 dlongkts

dlongkts

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 04 November 2009 - 02:56 PM

các số này nằm trong ô vuông do mình đánh lệnh leader.
Cả ô vuông và các số dạng này là 1 block không phá được
Mình copy cả cụm này cơ bạn Tuệ ah
  • 0

#330 Trần Diệu Nhân

Trần Diệu Nhân

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 04 November 2009 - 02:59 PM

các a trên diễn đàn xin giúp e, e có text c1, c2, c3... bây giờ e muốn thay toàn bộ các text trên thành c3, c4, c5, nghĩa là tăng thêm 2 đơn vị số trong text đó
ai biết giúp e nhá! :tongue2:
  • 0

#331 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 November 2009 - 08:36 PM

các a trên diễn đàn xin giúp e, e có text c1, c2, c3... bây giờ e muốn thay toàn bộ các text trên thành c3, c4, c5, nghĩa là tăng thêm 2 đơn vị số trong text đó
ai biết giúp e nhá! :tongue2:

Tue_NV viết cho trường hợp tổn quát :
Chuỗi của bạn được cấu thành từ string chữ đứng đầustring số đứng sau
Ví dụ : Th-1
thì Th- : là string chữ đứng đầu
1 : là string số đứng sau :
Lisp này Tue_NV viết sẽ tăng giảm đơn vị số trong text đó :
- Nếu tăng : Nhập số
- Nếu giảm : Nhập dấu trừ đằng trước số. Ví dụ : -2

(defun c:upts(/ ss so i ss ent str tdau lentcuoi sthay tcuoi so)
(vl-load-com)
;copyright by Tue_NV
(prompt "\n Chon cac TEXT :")
(setq ss (ssget '((0 . "TEXT"))) i 0)
(if (not soo) (setq soo 0.0))
(setq so (getreal (strcat "\n Nhap so muon cong them <" (rtos soo 2 0) "> :") ))
(if (not so) (setq so soo) (setq soo so))
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq str (cdr(assoc 1 ent)))
(setq tdau (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" str ))
(setq lentcuoi (- (strlen str) (strlen tdau) ))
(setq tcuoi (substr str (1+ (strlen tdau)) lentcuoi))
(setq sthay (rtos (+ (atof tcuoi) so) 2 0) )
(if (= (substr tcuoi 1 1) "0")
(setq sthay (strcat "0" (rtos (+ (atof tcuoi) so) 2 0)) )
)
(setq ent (entmod (subst (cons 1 (strcat tdau sthay)) (assoc 1 ent) ent)))
(setq i (1+ i))
)
(princ)
)

  • 2

#332 dlongkts

dlongkts

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 04 November 2009 - 09:10 PM

Em đánh lệnh leader (sử dụng lựa chọn setting/annotation/tolerance) sau đó copy dimleader đó sao cho cụm ký tự trong ô vuông tăng lên theo cấp số cộng với n=1
Vậy ai biết có lisp nào thì giúp em với nha! em sẽ mời :tongue2:
  • 0

#333 daotac541

daotac541

    biết vẽ circle

  • Members
  • PipPip
  • 30 Bài viết
Điểm đánh giá: 2 (bình thường)

Đã gửi 05 November 2009 - 01:12 AM

Tue_NV viết cho trường hợp tổn quát :
Chuỗi của bạn được cấu thành từ string chữ đứng đầustring số đứng sau
Ví dụ : Th-1
thì Th- : là string chữ đứng đầu
1 : là string số đứng sau :
Lisp này Tue_NV viết sẽ tăng giảm đơn vị số trong text đó :
- Nếu tăng : Nhập số
- Nếu giảm : Nhập dấu trừ đằng trước số. Ví dụ : -2

(defun c:upts(/ ss so i ss ent str tdau lentcuoi sthay tcuoi so)
(vl-load-com)
;copyright by Tue_NV
(prompt "\n Chon cac TEXT :")
(setq ss (ssget '((0 . "TEXT"))) i 0)
(if (not soo) (setq soo 0.0))
(setq so (getreal (strcat "\n Nhap so muon cong them <" (rtos soo 2 0) "> :") ))
(if (not so) (setq so soo) (setq soo so))
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq str (cdr(assoc 1 ent)))
(setq tdau (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" str ))
(setq lentcuoi (- (strlen str) (strlen tdau) ))
(setq tcuoi (substr str (1+ (strlen tdau)) lentcuoi))
(setq sthay (rtos (+ (atof tcuoi) so) 2 0) )
(if (= (substr tcuoi 1 1) "0")
(setq sthay (strcat "0" (rtos (+ (atof tcuoi) so) 2 0)) )
)
(setq ent (entmod (subst (cons 1 (strcat tdau sthay)) (assoc 1 ent) ent)))
(setq i (1+ i))
)
(princ)
)

Nhờ bác Tue NV viết dùm em cái lisp tác dụng tương tự như lisp trên nhưng thay vì sửa text trực tiếp thì lisp cho phép mình copy text.
Ví dụ + Có text "so1"
+ Sau khi chạy lisp sẽ hỏi : nhập số muốn cộng thêm ( ví dụ em nhập là 2)
+ Kết quả : pick điểm ta được 1 text khác là "so3", pick thêm điểm ta được text "so5"
Thx bác nhiều nhiều !!!!!!!!!!!
  • 1

#334 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 05 November 2009 - 06:36 AM

Nhờ bác Tue NV viết dùm em cái lisp tác dụng tương tự như lisp trên nhưng thay vì sửa text trực tiếp thì lisp cho phép mình copy text.
Ví dụ + Có text "so1"
+ Sau khi chạy lisp sẽ hỏi : nhập số muốn cộng thêm ( ví dụ em nhập là 2)
+ Kết quả : pick điểm ta được 1 text khác là "so3", pick thêm điểm ta được text "so5"
Thx bác nhiều nhiều !!!!!!!!!!!

Bạn Tuệ ơi! Bạn có lisp nào copy các số dạng 1+; 1-... sang một vị trí khác thành 2+; 2-... không?
Mình đang vẽ đường dốc cho ô tô mà

Chào bạn daotac541 và bạn dlongkts
Hai bạn có thể sử dụng Lisp này đã được bác ssg viết ở đây :
Bài viết số 6
Chức năng download Lisp file của diễn đàn đôi lúc bị lỗi. Nếu sử dụng chức năng này không được bạn nhấn nút Reply bài viết của bác ssg (không sót nhé) về chạy là được

@daotac541 và Trần Diệu Nhân : Lisp của Tue_NV viết theo ý của Trần Diệu Nhân là cập nhật vào các Text đã có theo ý của Trần Diệu Nhân và ý tưởng của Tue_NV được viết ở bài số 358.

@dlongkts : Tại bạn không nói rõ từ đầu là bạn dùng Block thuộc tính. Bạn sử dụng lệnh OCA của bác ssg nhé. Tuy nhiên, Lisp của bác ssg chỉ tăng giảm số đằng sau. Ví dụ +1 tăng lên +2 -> +3 ....
Nhưng ý của bạn lại là tăng giảm số đằng trước. vdụ : 1+ tăng 2+ -> 3+ .....
Vậy thì trong đoạn Lisp OCA bạn sửa lại như sau :
Thay dòng :
(setq
c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)

-> thành dòng :
(setq
c (vl-string-left-trim "0 1 2 3 4 5 6 7 8 9" cn)


và thay dòng : (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))

->thành dòng : (setq cn (strcat (incN (vl-string-subst "" c cn) dn) c))

Nếu không đúng ý bạn dlongkts thì bạn dlongkts vui lòng upload file .dwg lên diễn đàn và nói rõ điều bạn muốn

Chúc các bạn thành công :tongue2:
  • 2

#335 Trần Diệu Nhân

Trần Diệu Nhân

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 05 November 2009 - 07:49 AM

Bài số 358 kiếm ở đâu a Tue_NV ơi!
Cảm ơn a! lisp a viết dùng ngon lắm ạ! :tongue2:
E còn câu hỏi này nữa :
Anh Tue_NV! Giúp e cái lisp bố trí cột vào lưới với ạ!
File đính kèm đây a: http://www.mediafire...lvw3inzdwm/lisp dat ki hieu va bo tri cot.dwg
  • 0

#336 dlongkts

dlongkts

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 November 2009 - 07:50 AM

Bạn Tuệ ơi đây là link: http://www.cadviet.c...2/duongdoc1.dwg
  • 0

#337 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 05 November 2009 - 08:21 AM

Bạn Tuệ ơi đây là link: http://www.cadviet.c...2/duongdoc1.dwg

Chào bạn dlongkts
Bạn đã đọc bài viết số 361 và làm theo ý của Tue_NV chưa?
Bản vẽ của bạn có rất nhiều file Xref nên Tue_NV mở không thấy gì cả ở Model
Bạn nên làm theo ý của Tue_NV trước đã. Có khó khăn gì post lên đây. Mình sẽ giúp

@Trần Diệu Nhân : Tue_NV đã đọc bài viết và cần có thời gian mới viết được Lisp này. Dạo này mình hơi bận. Bạn chịu khó chờ vậy.
  • 1

#338 dlongkts

dlongkts

    biết vẽ line

  • Members
  • PipPip
  • 24 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 05 November 2009 - 08:47 AM

http://www.cadviet.c...uongdoccopy.dwg
Vừa rồi mình phải làm thủ công nên mất thời gian quá. Mình đã blind rồi nên không bị xref nữa
  • 0

#339 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 05 November 2009 - 11:12 AM

Bài số 358 kiếm ở đâu a Tue_NV ơi!
Cảm ơn a! lisp a viết dùng ngon lắm ạ! :tongue2:
E còn câu hỏi này nữa :
Anh Tue_NV! Giúp e cái lisp bố trí cột vào lưới với ạ!
File đính kèm đây a: http://www.mediafire...lvw3inzdwm/lisp dat ki hieu va bo tri cot.dwg

Chào bạn Trần Diệu Nhân và bạn dlongkts.
Bài viết số 358 ở ngay trongtopic này bạn ạ. Tỷ như bài post của bạn Trần diệu nhân trên đây là bài viết số 362 của topic này.
Các bạn có thể post bản vẽ ở dạng Cad2004 được không. Như vậy sẽ có nhiều người đọc được hơn và khả năng có thể giúp các bạn cao hơn.
Thanks all
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#340 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 05 November 2009 - 04:39 PM

....
E còn câu hỏi này nữa :
Anh Tue_NV! Giúp e cái lisp bố trí cột vào lưới với ạ!
File đính kèm đây a: http://www.mediafire...lvw3inzdwm/lisp dat ki hieu va bo tri cot.dwg

Phù. Cuối cùng cũng hoàn thành Lisp bố trí cột vào lưới
'Trần Diệu Nhân' thử nhé
Chức năng download Lisp file của diễn đàn đôi lúc bị lỗi. Nếu sử dụng chức năng này không được bạn nhấn nút Reply bài viết của Tue_NV (không sót nhé) về chạy là được
(defun c:ltruc(/ oldos dai rong ang i j ssx ssy ltx lty ent dau cuoi ang i
minx miny maxx maxy i1 i2 i3 i4 pt1 pt2 pt3 pt4 in)
(vl-load-com)
;copyright by Tue_NV
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(Setq dai (getdist "\n chieu dai cot theo phuong X :"))
(Setq rong (getdist "\n chieu rong cot theo phuong Y :"))
(setq ang 0)
(setq ss (ssget '((0 . "*LINE"))) i 0 j 0
ssx (ssadd) ssy (ssadd) ltx nil lty nil)

(Repeat (sslength ss)
(setq ent (ssname ss i))
(setq dau (vlax-curve-getStartPoint ent))
(setq cuoi (vlax-curve-getEndPoint ent))

(if (or (= (angle dau cuoi) ang) (= (angle dau cuoi) (+ ang pi)) )
(progn
(if (= (angle dau cuoi) pi)
(progn
(setq dau (vlax-curve-getEndPoint ent))
(setq cuoi (vlax-curve-getStartPoint ent))
)
)
(setq ssx (ssadd ent ssx))
(setq ltx (append ltx (list (list dau cuoi ent))))
)
)

(if (or (= (angle dau cuoi) (+ ang (/ pi 2)) ) (= (angle dau cuoi) (+ ang (/ (* 3 pi) 2))) )
(progn
(if (= (angle dau cuoi) pi)
(progn
(setq dau (vlax-curve-getEndPoint ent))
(setq cuoi (vlax-curve-getStartPoint ent))
)
)
(setq ssy (ssadd ent ssy))
(setq lty (append lty (list (list dau cuoi ent))))
)
)
(setq i (1+ i))
)
(setq ltx (vl-sort ltx '(lambda (x1 x2) (< (cadr(car x1)) (cadr(car x2)))
)
)
)
(setq lty (vl-sort lty '(lambda (y1 y2) (< (car(car y1)) (car(car y2)))
)
)
)
(alert "\n Vui long cho mot chut. Chuong trinh se bo tri luoi cot cho ban")
;Case #1
(setq minx (car ltx) miny (car lty)
maxx (nth (1- (length ltx)) ltx)
maxy (nth (1- (length lty)) lty)
i1 (car(giaodt (caddr minx) (caddr miny)))
i2 (car(giaodt (caddr maxx) (caddr maxy)))
i3 (car(giaodt (caddr maxx) (caddr miny)))
i4 (car(giaodt (caddr maxy) (caddr minx)))
pt1 (list (+ (car i1) dai) (+ (cadr i1) rong) 0)
pt2 (list (- (car i2) dai) (- (cadr i2) rong) 0)
pt3 (list (+ (car i3) dai) (- (cadr i3) rong) 0)
pt4 (list (- (car i4) dai) (+ (cadr i4) rong) 0)
)
(vecot i1 pt1)
(vecot i2 pt2)
(vecot i3 pt3)
(vecot i4 pt4)


(setq ltx (vl-remove minx ltx)) (setq ltx (vl-remove maxx ltx))
(setq lty (vl-remove miny lty)) (setq lty (vl-remove maxy lty))

;Case #2 : Intersect minx - y
(foreach x lty
(setq in (car(giaodt (caddr minx) (caddr x)))
pt1 (list (- (car in) (/ dai 2)) (cadr in) 0)
pt2 (list (+ (car in) (/ dai 2)) (+ (cadr in) rong) 0)
)
(vecot pt1 pt2)
);foreach

;Case #3 : Intersect maxx - y
(foreach x lty
(setq in (car(giaodt (caddr maxx) (caddr x)))
pt1 (list (- (car in) (/ dai 2)) (cadr in) 0)
pt2 (list (+ (car in) (/ dai 2)) (- (cadr in) rong) 0)
)
(vecot pt1 pt2)
);foreach

;Case #4 : Intersect miny - x
(foreach x ltx
(setq in (car(giaodt (caddr miny) (caddr x)))
pt1 (list (car in) (- (cadr in) (/ rong 2)) 0)
pt2 (list (+ (car in) dai) (+ (cadr in) (/ rong 2)) 0)
)
(vecot pt1 pt2)
);foreach

;Case #5 : Intersect maxy - x
(foreach x ltx
(setq in (car(giaodt (caddr maxy) (caddr x)))
pt1 (list (car in) (+ (cadr in) (/ rong 2)) 0)
pt2 (list (- (car in) dai) (- (cadr in) (/ rong 2)) 0)
)
(vecot pt1 pt2)
);foreach

;Case #5 : Intersect maxxy - minxy
(foreach x ltx
(foreach y lty
(setq in (car(giaodt (caddr x) (caddr y)))
pt1 (list (- (car in) (/ dai 2)) (- (cadr in) (/ rong 2)) 0)
pt2 (list (+ (car in) (/ dai 2)) (+ (cadr in) (/ rong 2)) 0)
)
(vecot pt1 pt2)
);foreach
);foreach
(alert "\n Finish")
(setvar "osmode" oldos)
(command "undo" "be")
(princ)
)
;
(defun vecot(p1 p2)
(command "rectang" p1 p2)
;(command "zoom" "w" p1 p2)
(command "hatch" "solid" (entlast) "")
;(command "zoom" "P")
(princ)
)
;
(defun GiaoDT (ent1 ent2)
(setq ob1 (vlax-ename->vla-object ent1)
ob2 (vlax-ename->vla-object ent2)
)
(setq g (vlax-variant-value
(vla-IntersectWith ob1 ob2 acExtendNone)
)
)
(if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
)
(if g
(progn
(setq kq nil
sd (fix (/ (length g) 3))
)
(repeat sd
(setq kq (append kq (list (list (car g) (cadr g) (caddr g))))
g (cdddr g)
)
)
kq
)
nil
)

)
iluvyousmiley.gif
  • 1