Đến nội dung


Hình ảnh
- - - - -

[Yêu Cầu] Cắm Cọc Gpmb Trên 2 Mép Ngoài Taluy Trên Bình Đồ


  • Please log in to reply
66 replies to this topic

#1 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 15 October 2015 - 11:48 AM

Chào các bác!

Em muốn nhờ các bác giúp em viết cái lisp cắm cọc GPMB ở 2 bên mép ngoài taluy trên bình đồ với ạ.

Cụ thể yêu cầu em xin phép trình bày trong bản vẽ dưới đây:

http://www.cadviet.c...4560_gpmbbd.dwg

P/s: à không cần cái nét đứt như trong hình yêu cầu đâu nhé, em vẽ vào để hiển thị thôi.

 

Em mới tham gia diễn đàn, còn phải học hỏi rất nhiều, mong các bác giúp đỡ, mắng chửi em nhiệt tình vào để khá hơn ạ.


  • -1

#2 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 16 October 2015 - 07:36 AM

Các pro giúp em với


  • -1

#3 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 16 October 2015 - 09:59 AM

Rảnh nên mò mẫn lại tí, quên cả rồi :D

(defun c:DONG ()
(vl-load-com)
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nChon BD muon dong coc GPMB !")
(setq ss (ssget '((8 . "MEPTLT,MEPTLP,ENTCOC"))))
(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq coc (vl-remove-if-not '(lambda(x) (= "ENTCOC" (cdr (assoc 8 (entget x))))) lst_name)
	  tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
	  tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
(foreach c coc
	(setq trai (vlax-invoke (vlax-ename->vla-object c) 'intersectwith tlt acExtendThisEntity)
		  phai (vlax-invoke (vlax-ename->vla-object c) 'intersectwith tlp acExtendThisEntity))
	(command "_.insert" "cocmoc" trai 25.4 "" "")
	(command "_.insert" "cocmoc" phai 25.4 "" "")
)
(mapcar 'setvar lst_va old)
(princ)
)

- Để block được chèn đúng vị trí, bạn cần:

    Chỉnh sửa điểm chèn cái block của bạn đúng tâm đường tròn (đã có bài hướng dẫn cụ thể trên diễn đàn)

   ..... :D :D :D


  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#4 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 16 October 2015 - 11:11 AM

Các pro giúp em với

Hề hề hề,

Bạn tham khảo lisp sau đây. Lưu ý hai vấn đề sau:

1/ Bạn phải tạo block "cocmoc1" có các thành phần giống như block cocmoc của bạn nhưng có điểm chèn là tâm của hình tròn bao. (mình đã tạo block này trong file bản vẽ gửi kèm ở bài này)

2/- hãy xóa các pline mép taluy trùng nhau (khá nhiều đấy) để tránh chèn trùng lắp quá nhiều block. (Trong file bản vẽ kèm theo ở đây mình đã xáo hết chỉ để lại mỗii bên một đường thôi.)

Hãy test thử và cho ý kiến nếu cần chỉnh sửa nhé.

 

http://www.cadviet.c...amcocgpmb_1.lsp

 

http://www.cadviet.c...60_gpmbbd_1.dwg

(defun c:ccmb (/ oldos ls1 ls2 plst )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(alert "Chon cac coc tim duong")
(setq ls1 (acet-ss-to-list (ssget (list (cons 0 "line") (cons 8 "entcoc")))) )
(alert "Chon cac duong mep taluy ")
(setq ls2 (acet-ss-to-list (ssget (list (cons 0 "*line") (cons 8 "dientichtn")))) 
          plst (list) )
(foreach e1 ls1
         (foreach e2 ls2
                (setq plst (append plst (acet-geom-intersectwith e1 e2 1)))
         )
)
(command "undo" "be")
(foreach p plst
         (command "insert" "cocmoc1" p 1 1 0)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 16 October 2015 - 11:25 AM

Cảm ơn hiepttr và phamthanhbinh rất rất nhiếu hì hì.

1. Bản của hiepttr mình test không hiểu vì sao các block bị phóng to lên, không đúng với kích cỡ của block, chi tiết trong bản vẽ mình gửi kèm lên, bạn xem mình bị lỗi chỗ nào nhé.

2. Bản của phamthanhbinh mình dùng thì dùng ok rồi :D

http://www.cadviet.c...4560_gpmbbd.lsp


  • 0

#6 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 16 October 2015 - 02:05 PM

Cảm ơn hiepttr và phamthanhbinh rất rất nhiếu hì hì.

1. Bản của hiepttr mình test không hiểu vì sao các block bị phóng to lên, không đúng với kích cỡ của block, chi tiết trong bản vẽ mình gửi kèm lên, bạn xem mình bị lỗi chỗ nào nhé.

2. Bản của phamthanhbinh mình dùng thì dùng ok rồi :D

http://www.cadviet.c...4560_gpmbbd.lsp

Hề hề hề,

Vì bác Hieptr cận thị nên phóng cái block ấy lên 25.4 lần ấy mà. Nếu bạn không thích thì sửa lại:

(command "_.insert" "cocmoc" trai 25.4 "" "") (command "_.insert" "cocmoc" phai 25.4 "" "")

thành

(command "_.insert" "cocmoc" trai 1 "" "") (command "_.insert" "cocmoc" phai 1 "" "")


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#7 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 16 October 2015 - 04:18 PM

ok thank bác :D


  • 0

#8 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 17 October 2015 - 08:01 AM

@bác Bình: Cái tật cận thị là xuất phát từ BV mẫu của chủ thớt mừ :D :D :D


  • 0

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#9 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 17 October 2015 - 08:08 AM

Em có viết chương trình Extend Line về 2 phía. Không biết ai cần ko? ^^

(vl-load-com)
(defun c:EXL2P (/ OBJPL1 OBJPL2 SSOBJLINE VLAOBJPL1 VLAOBJPL2)
;;;;EXTEND LINE 2 PHIA
  (setq ObjPL1 (car (entsel "\nChon duong chan thu nhat: ")))
  (setq ObjPL2 (car (entsel "\nChon duong chan thu hai ")))
  (setq VlaObjPL1 (vlax-ename->vla-object ObjPL1))
  (setq VlaObjPL2 (vlax-ename->vla-object ObjPL2))
  (setq ssObjLine (LM:ss->ent (ssget (list (cons 0 "LINE")))))
  (foreach eL ssObjLine
    (EntmodLine eL ObjPL1)
    (EntmodLine eL ObjPL2)
  )
  (princ)
)

(defun EntmodLine (ObjLine  ObjPLine /	      VlaLine  VlaPline
		   Lts1	    P1	     P2	      Ds_KC1   Ds_KC2
		   di1	    di2
		  )
  (setq VlaLine (vlax-ename->vla-object ObjLine))
  (setq VlaPline (vlax-ename->vla-object ObjPLine))
  (setq Lts1 (LM:Intersections VlaLine VlaPline acextendboth))
  (setq P1 (acet-dxf 10 (entget ObjLine)))
  (setq P2 (acet-dxf 11 (entget ObjLine)))
  (setq Ds_KC1 (mapcar '(lambda (x) (list (distance P1 x) x)) Lts1))
  (setq Ds_KC2 (mapcar '(lambda (x) (list (distance P2 x) x)) Lts1))
  (setq di1 (car (vl-sort Ds_KC1 '(lambda (x y) (< (car x) (car y))))))
  (setq di2 (car (vl-sort Ds_KC2 '(lambda (x y) (< (car x) (car y))))))
  (if (< (car di1) (car di2))
    (entmod (subst (cons 10 (last di1))
		   (assoc 10 (entget ObjLine))
		   (entget ObjLine)
	    )
    )
    (entmod (subst (cons 11 (last di2))
		   (assoc 11 (entget ObjLine))
		   (entget ObjLine)
	    )
    )
  )
)





;;;; acextendnone
(defun LM:Intersections	(obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
	  l (cdddr l)
    )
  )
  (reverse r)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)

  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#10 stinger

stinger

    Chưa sử dụng CAD

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

Đã gửi 28 October 2015 - 10:51 AM

Bác chủ cho em ké tý

Nhờ các chuyên gia phán hộ sao em ko thay đổi được giá trị tọa độ 2 đầu line = hàm subst được nhỉ

Code dạng này

(setq ent (entget (car (entsel "select a line: ")))

(setq p '(0 0 0)) ; toạ độ này do tính toán, em tạm ví dụ thế

(setq ent (subst (cons 10 p)(cons 10 ent) ent))

(entupd (cdr(assoc -1 ent)))

(entmod ent)

 

sau câu lệnh subst, em xem data của ent thì vẫn như cũ, chả thay đổi j, các bác chỉ giúp xem sai chỗ nào với


  • 0

#11 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 28 October 2015 - 11:25 AM

Thay cons bằng assoc

(setq ent (subst (cons 10 p)(assoc 10 ent) ent))


  • 0

#12 stinger

stinger

    Chưa sử dụng CAD

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

Đã gửi 28 October 2015 - 04:26 PM

Thay cons bằng assoc

(setq ent (subst (cons 10 p)(assoc 10 ent) ent

thank bác.

 lâu ko làm nên cũng quên nhiều


  • 0

#13 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 02 November 2015 - 08:17 AM

Nhờ các bác phát triển lisp này có thêm kích thước từ tim cọc GPMB hai bên mép taluy đến tim đường như trong hình với ạ.

 

 

64560_untitled.png

 

 

Còn đây là 2 lisp của bác hieptr và bác phamthanhbinh

http://www.cadviet.c...60_gpmbbd_1.lsp

http://www.cadviet.c...560_gpmbbd2.lsp

 

Đây là file yêu cầu của em ạ.

http://www.cadviet.c...560_gpmbbd1.dwg


  • -1

#14 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 02 November 2015 - 01:50 PM

Các pro giúp em vơi ạ 


  • -1

#15 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 02 November 2015 - 03:09 PM

Pro thì không dám nhưng cũng sửa cho bạn đây: :D :D :D 

(defun c:DONG2 ( / lst_va old ss lst_name coc tlt tlp ob trai phai mid mid_pt)
(vl-load-com)
(defun mid(p1 p2)(mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nChon BD muon dong coc GPMB !")
(setq ss (ssget '((8 . "MEPTLT,MEPTLP,ENTCOC"))))
(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq coc (vl-remove-if-not '(lambda(x) (= "ENTCOC" (cdr (assoc 8 (entget x))))) lst_name)
	  tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
	  tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
(foreach c coc
	(setq trai (vlax-invoke (setq ob (vlax-ename->vla-object c)) 'intersectwith tlt acExtendThisEntity)
		  phai (vlax-invoke ob 'intersectwith tlp acExtendThisEntity)
		  mid_pt (mid (vlax-curve-getStartpoint c) (vlax-curve-getEndpoint c)))
	(command "_.insert" "cocmoc" trai 1 "" "")
	(command "_.insert" "cocmoc" phai 1 "" "")
	(command ".DIMALIGNED" mid_pt trai mid_pt)
	(command ".DIMALIGNED" mid_pt phai mid_pt)
)
(mapcar 'setvar lst_va old)
(princ)
)

  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#16 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 02 November 2015 - 03:50 PM

Hì hì, làm phiền bác nhiều ngại quá, thank bác nhiều :D


  • 0

#17 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 09 November 2015 - 02:57 PM

- Trước khi mặt dày lại nhờ vả các bác tiếp em xin cảm ơn các bác trong diễn đàn cadviet rất nhiều, em tuy là newbie n các bác vẫn nhiệt tình giúp đỡ và trả lời mọi thắc mắc ko chỉ riêng em và còn rất nhiều thành viên khác nữa. Và đặc biệt cảm ơn 2 bác hiepttr và bác phamthanhbinh.

- Nhờ bác sau khi làm xong hồ sơ cắm cọc GPMB với tốc độ chóng mặt thì bên chủ đầu tư lại yêu cầu bên em phải xuất tọa độ cọc giải phóng mặt bằng của từng cọc và ghi rõ tại vị trí cọc nào ạ. 

- Dưới đây là mẫu bảng biểu, file bình đồ mẫu đầy đủ tên cọc, và lisp cắm cọc của bác hiepttr em đang dùng ạ.

http://www.cadviet.c...xuat_toa_do.zip

http://www.cadviet.c...o_gpmb_2932.dwg

http://www.cadviet.c..._kich_thuoc.lsp


  • -2

#18 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 10 November 2015 - 09:57 AM

- Mình chỉ code lúc rảnh và ngoài việc giúp bạn ra nó còn giúp mình ôn bài :D nên nếu hài lòng bạn chỉ cần kích like là đủ :D :D :D

- File xuất ra, bạn mở bằng excel, và nhớ cài đặt dấu ngắt phần thập phân là dấu chấm. Biểu mẫu file mình không theo ý bạn 100%, mình để chừa cột STT lại để bạn làm bằng excel thì linh động hơn, cột Y mình để trước, X để sau, thuận lợi trong việc nhập máy toàn đạc ...

 

p/s:

- Chú ý, Tên cọc được lấy từ XData của line ENTCOC nên trong quá trình biên tập bình đồ bạn không nên copy line của cọc này sang cọc kia, Hoặc thay đổi tên cọc trên Text thì lisp cũng không nhận được !

- Mình có sửa chút ít để lisp dim đúng form của bạn và không bị lỗi khi line ENTCOC cắt mỗi đường biên > 1 điểm.

(defun c:DONG3 ( / lst_va old ss lst_name coc tlt tlp ob trai phai mid mid_pt fn pw ten_coc)
(vl-load-com)
(defun mid(p1 p2)(mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nChon BD muon dong coc GPMB !")
(setq ss (ssget '((8 . "MEPTLT,MEPTLP,ENTCOC"))))
(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq coc (vl-remove-if-not '(lambda(x) (= "ENTCOC" (cdr (assoc 8 (entget x))))) lst_name)
	  tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
	  tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,Tencoc,Y,X" pw)
(foreach c coc
	(setq ten_coc	(cdr 
						(car
							(vl-remove-if-not '(lambda (x) (= 1000 (car x))) (cdr (last (assoc -3 (entget c '("*"))))))
						)
					)
	)
	(setq trai (if (= 3 (length (setq trai (vlax-invoke (setq ob (vlax-ename->vla-object c)) 'intersectwith tlt acExtendThisEntity))))
					trai
					(list (car trai) (cadr trai) (caddr trai))
				)
		  phai (if (= 3 (length (setq phai (vlax-invoke ob 'intersectwith tlp acExtendThisEntity))))
					phai
					(list (car phai) (cadr phai) (caddr phai))
				)
		  mid_pt (mid (vlax-curve-getStartpoint c) (vlax-curve-getEndpoint c)))
	(command "_.insert" "cocmoc" trai 1 "" "")
	(command "_.insert" "cocmoc" phai 1 "" "")
	(command ".DIMALIGNED" mid_pt trai (mid trai mid_pt))
	(command ".DIMALIGNED" mid_pt phai (mid phai mid_pt))
	(write-line (strcat "" "," "P-" ten_coc "," (rtos (cadr phai) 2 3) "," (rtos (car phai) 2 3)) pw)
	(write-line (strcat "" "," "T-" ten_coc "," (rtos (cadr trai) 2 3) "," (rtos (car trai) 2 3)) pw)
)
(close pw)
(mapcar 'setvar lst_va old)
(princ)
)

  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson


#19 dangky2510

dangky2510

    biết vẽ circle

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

Đã gửi 10 November 2015 - 11:26 AM

- Cảm ơn bác đã nhiệt tình giúp em nhé, bác chỉ làm lúc rảnh mà giúp được em làm nhanh hơn được bao nhiêu lần đấy :D.

- Em xuất ra bản vẽ thấy OK rồi, mới đầu e quên chưa chuyển dấu thập phân về dấu chấm thì thấy tất cả dữ liệu về 1 cột hết, sau chuyển lại thì lại ngon rồi hì hì. để lúc làm có vấn đề gì thì phản hồi bác tiếp.

- Bây giờ em mới biết đến khái niệm Xdata đấy, bác có thể nói rõ hơn được không, e search n ko bài nào nêu cụ thể cả. Thực ra lúc ra yêu cầu này e chỉ mong xuất được tọa độ cọc thôi chứ ko mong được cả tên cọc vì nghĩ không có cơ sở dữ liệu nào để biết cọc nào tên là gì cả.

- Lúc nào rảnh bác nghiên cứu em xuất ra bảng kích thước từ tim ra cọc giải phóng mặt bằng bên trái và bên phải tuyến phát nhé, mẫu giống file dưới em gửi ạ.

http://www.cadviet.c..._kich_thuoc.zip

À em ở Hòa Bình, có dịp đi qua chơi bác alo em, bác với em giao lưu cảm ơn bác :D 

SĐT em: 0975.819.020


  • 0

#20 hiepttr

hiepttr

    Edu level: li10

  • Members
  • PipPipPipPipPipPipPip
  • 1298 Bài viết
Điểm đánh giá: 518 (tốt)

Đã gửi 10 November 2015 - 02:32 PM

- Bạn có thể dùng lisp này, 2 trong 1 :D

(defun c:DONG3 ( / lst_va old ss lst_name coc tlt tlp ob trai phai mid mid_pt fn pw ten_coc)
(vl-load-com)
(defun mid(p1 p2)(mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
(setq lst_va '("osmode" "cmdecho"))
(setq old (mapcar 'getvar lst_va))
(mapcar 'setvar lst_va '(0 0))
(prompt "\nChon BD muon dong coc GPMB !")
(setq ss (ssget '((8 . "MEPTLT,MEPTLP,ENTCOC"))))
(setq lst_name (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq coc (vl-remove-if-not '(lambda(x) (= "ENTCOC" (cdr (assoc 8 (entget x))))) lst_name)
	  tlt (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLT" (cdr (assoc 8 (entget x))))) lst_name)))
	  tlp (vlax-ename->vla-object (car (vl-remove-if-not '(lambda(x) (= "MEPTLP" (cdr (assoc 8 (entget x))))) lst_name))))
(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
(setq pw (open fn "w"))
(write-line "STT,Ten coc,Trai,,,Phai" pw)
(write-line ",,K/cach den tim,Y,X,K/cach den tim,Y,X" pw)
(foreach c coc
	(setq ten_coc	(cdr 
						(car
							(vl-remove-if-not '(lambda (x) (= 1000 (car x))) (cdr (last (assoc -3 (entget c '("*"))))))
						)
					)
	)
	(setq trai (if (= 3 (length (setq trai (vlax-invoke (setq ob (vlax-ename->vla-object c)) 'intersectwith tlt acExtendThisEntity))))
					trai
					(list (car trai) (cadr trai) (caddr trai))
				)
		  phai (if (= 3 (length (setq phai (vlax-invoke ob 'intersectwith tlp acExtendThisEntity))))
					phai
					(list (car phai) (cadr phai) (caddr phai))
				)
		  mid_pt (mid (vlax-curve-getStartpoint c) (vlax-curve-getEndpoint c)))
	(command "_.insert" "cocmoc" trai 1 "" "")
	(command "_.insert" "cocmoc" phai 1 "" "")
	(command ".DIMALIGNED" mid_pt trai (mid trai mid_pt))
	(command ".DIMALIGNED" mid_pt phai (mid phai mid_pt))
	(write-line (strcat "," ten_coc "," (rtos (distance mid_pt trai) 2 3) "," (rtos (cadr trai) 2 3) "," (rtos (car trai) 2 3)
									"," (rtos (distance mid_pt phai) 2 3) "," (rtos (cadr phai) 2 3) "," (rtos (car phai) 2 3)) pw)
)
(close pw)
(mapcar 'setvar lst_va old)
(princ)
)

  • 1

Có vợ dù dữ dù hiền , bạn đều có lợi
_ Nếu vợ hiền, bạn sẽ là người đàn ông sung sướng
_ Nếu vợ dữ, bạn sẽ thành ... triết gia !

Bergson