Chuyển đến nội dung
Diễn đàn CADViet
Nguyen Hoanh

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

Bởi Nguyen Hoanh , trong AutoLisp

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

sucuph    1

sucuph
Đã đăng

Cảm ơn bác Bình rất nhiều, em đã chạy thử lisp bác viết cho, chạy ổn cả, nhưng vẫn chưa đúng mục đích của em lắm. Mục đích của em là khi pick vào đường PL đó thì sẽ in được toạ độ x=.., y=..., z=... lên bản vẽ tại chính vị trí point đó và đồng thời xuất dữ liệu ra file txt. Em nhờ các bác giúp cho, em đang rất cần. Em đang có một đường PL khoảng 600 point mà không có các bác giúp chắc em chết!!! Thanks các bác nhiều!!!

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

Tue_NV    3.912

Tue_NV
Đã đăng
Cảm ơn bác Bình rất nhiều, em đã chạy thử lisp bác viết cho, chạy ổn cả, nhưng vẫn chưa đúng mục đích của em lắm. Mục đích của em là khi pick vào đường PL đó thì sẽ in được toạ độ x=.., y=..., z=... lên bản vẽ tại chính vị trí point đó và đồng thời xuất dữ liệu ra file txt. Em nhờ các bác giúp cho, em đang rất cần. Em đang có một đường PL khoảng 600 point mà không có các bác giúp chắc em chết!!! Thanks các bác nhiều!!!

Chào sucuph

Có thể rằng sucuph đang rất cần Code Lisp trên nhưng sucuph không có quyền được post 1 chủ đề của sucuph

ở 2 nơi như thế. Ở bên này, sucuph đã mở ra topic với nội dung trên và bạn hoaletrang đã viết bài trả lời cho sucuph

http://www.cadviet.com/forum/index.php?sho...amp;#entry90218

 

CẢNH CÁO THÀNH VIÊN

Nếu ai cũng tuỳ tiện như vậy, tính tổ chức của diễn đàn sẽ bị phá vỡ. Khi ai đó muốn tìm hiểu về một vấn đề nào đó, cũng như các vấn đề khác có liên quan sẽ không thuận tiện vì chúng nằm rải rác khắp nơi. Trong khi các quản trị viên cố gắng sắp xếp, thu gom các bài viết có nội dung tương tự nhau về cùng một topic thì bạn làm ngược lại!

 

Bạn đừng nghĩ rằng post lung tung ở nhiều nơi sẽ có nhiều người quan tâm giúp bạn. Đúng là có nhiều người quan tâm thật, nhưng những người "quan tâm đặc biệt" chính các admin và mod! Thật tình chúng tôi không muốn, nhưng buộc phải làm cái việc bất đắc dĩ là del tất cả các bài của bạn có trùng nội dung như đã nói trên.

 

Bạn hãy cân nhắc kỹ, vấn đề bạn nêu nên ở chỗ nào là hợp lý nhất và có thể post lại, nhưng chỉ duy nhất ở chỗ ấy thôi. Nếu lâu quá không thấy reply, bạn có thể nhắc lại ngay trong topic đó. Tuyệt đối không được mở thêm topic mới cho cùng vấn đề trên. Ngoài ra, cũng xin lưu ý với bạn rằng, nêu vấn đề là quyền của bạn, nhưng có nhận được reply hay không là quyền của nhiều members khác. Lý do có thể rất nhiều: vấn đề khó quá, vấn đề không phổ biến đối với đa số, vấn đề đã được đề cập và giải quyết rồi, người ta đang bận v.v... và cũng có thể là do chính bạn diễn đạt chưa rõ ràng.

 

Cảm ơn bạn Tue_Vn và bạn Thanhbinh, bạn Tue đã làm đúng theo ý mình rồi, vậy bạn có thể chỉ cho mình cách nào để làm được như thế không? còn theo cách của Thanhbinh thì mình đã thử rồi ( mình dùng Draw Order rồi nhưng vẫn không được. Xin các cao thủ chỉ giáo giúp. Thanks

Chào bạn missyoutd01

Trước hết bạn đọc các bài viết trong Topic này nhé :

http://www.cadviet.com/forum/index.php?showtopic=15978

Và bạn hãy thực hiện các lệnh trong đó và coi thử bạn có đáp ứng yêu cầu của bạn hay không? Và có gì chưa được thì bạn hãy post vào trong topic đó luôn nhé. . Tue_NV sẽ trả lời bạn ngay chính trong topic đó. OK?

 

Gợi ý : Yêu cầu của bạn giải quyết bằng 3 lệnh : BEDIT, WIPEOUT và DRAWORDER

Chúc bạn thành công

  • Vote tăng 1

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

hoanganhqa    0

hoanganhqa
Đã đăng

Chào mọi người hôm nay đọc mấy cái líp của các bạn thấy hấp dẫn ghê,nhưng tôi chưa biết cách sử dụng các bạn có thể chỉ giùm không

Cảm ơn nhiều!

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

bosstuyentn    1

bosstuyentn
Đã đăng

Em cần các huynh viết hộ cái lisp như trong hình. Làm sao khi em muốn vẽ các hình dạng ống, em chỉ cần vẽ đuờng line truớc làm trục tâm ống, rùi nhập bán kính hình tròn trong hình tròn ngoài rùi tự động nó uốn theo đuờng line em vẽ lúc đầu. Đối với ống dạng đa giác cũng tuơng tự, sau khi vẽ đuờng line hay pline làm tâm. Nhập chiều các cạnh hình trong, rùi hình ngoài, kết quả là nó uốn theo đuờng tâm line lúc đầu. MOng các bác giúp em với. Em làm thủ công vừa tay to vừa lâu

ongong.gif

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

thiep    365

thiep
Đã đăng
Cảm ơn anh Thiệp và anh Tue_NV! Nhờ sự giúp đỡ của các anh, em đã hoàn thành được rồi.

Nay em lại có một việc khác muốn nhờ.

 

c.jpg

 

Như trên hình minh hoạ, em cần đánh dấu chiều chảy vào các ống của các lưu vực.

Ví dụ như ô số 23 và 32, cần vẽ các mũi tên hướng từ tâm ra phía đường ống cho toàn bộ các ô trong bản vẽ (để thể hiện chiều chảy của nước).

Nhờ các anh giúp đỡ! Em xin chân thành cảm ơn!

File minh hoạ

http://www.cadviet.com/upfiles/2/d_1.dwg

Chào svba1608, Lisp này sẽ giúp cho svba1608 thêm mũi tên tạo dốc nước chảy. Tuy nhiên để cho lisp chạy 1 cách đầy đủ không bỏ sót thì các đường bao "ranh thửa" phải là đường kín (closed). Để biết 1 pline có closed hay không hãy pick chúng và xem cửa sổ property tại mục closed nó báo YES hay NO nếu NO thì chỉnh lại YES. Ngoài ra, vì chiễu mũi tên sẽ hướng từ điểm dóng của text ra đến điểm gần nhất của pline đường bao, nên các text A, B, C, D.. phải nằm gần đường ống hơn.

;| Lisp tao leader arrow tu text trong
 LWPOLYLINE ra bien LWPOLYLINE
 Yeu cau: - LWPOLYLINE phai kin(closed)
      - Express tools phai duoc cai dat
 Copyright by thiep 03/2010|;
;;;======================
(defun dxf (code ent)
 (cdr (assoc code (entget ent)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun SAVE_MODE ()
 (setq	OLD_OSMODE    (getvar "OSMODE")
OLD_ORTHOMODE (getvar "ORTHOMODE")
 )
 (setvar "cmdecho" 0)
 (setvar "OSMODE" 0)
)
(defun RESTORE ()
 (setvar "osmode" OLD_OSMODE)
 (setvar "ORTHOMODE" OLD_ORTHOMODE)
)
(defun leader (pt1 pt2 tsi / el entle )
 (setq	el
 (list
   (cons 0 "LEADER")
   (cons 100 "AcDbEntity")
   (cons 100 "AcDbLeader")
   (cons 10 pt1)
   (cons 10 pt2)
 ) ;_  list
 ) ;_  setq
 (entmake el)
 (setq	entle (entlast)
objle (vlax-ename->vla-object entle)
 )
 (vla-put-ArrowheadType objle acArrowOpen30)
 (vla-put-ArrowheadSize objle tsi)
)

;;;------------------
(defun zoomObj (OBcur / lop upp)
 (vla-getboundingbox OBcur 'minp 'maxp)
 (setq	lop (vlax-safearray->list minp)
upp (vlax-safearray->list maxp)
 )
 (vla-zoomwindow (vlax-get-acad-object) minp maxp)
)
;|===========================================================
                     MAIN LISP                              
===========================================================|;
(defun c:sva (/	lstent	lsttextt	tsi	lstent	lstpoCP
	lstenttext	p1	p2	p3	p4	objLwp
	objle	entle	ss	lstLWP2	po	ang	dis
	strso	lstpo	en	n	
       )
 (or ActDoc
     (setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or *Model* (setq *Model* (vla-get-ModelSpace ActDoc)))
 (vla-StartUndoMark ActDoc)
 (SAVE_MODE)
 (setq	ss     (ssget '((0 . "LWPOLYLINE")
		(8 . "vh")
	       )
       )
lstent (acet-ss-to-list ss)
 )
;;;---------------------------------------------
 (foreach entlwp lstent
   (setq objlwp  (vlax-ename->vla-object entlwp)
  lstpoCP (ACET-LIST-REMOVE-DUPLICATES
	    (ACET-GEOM-VERTEX-LIST entlwp)
	    0
	  )
   )
   (zoomObj objlwp)
   (if	(or (vlax-curve-isClosed entlwp)
    (< (distance (car lstpoCP) (last lstpoCP)) 0.1)
)
     (progn
(setq ss (ssget	"CP"
		lstpoCP
		'((0 . "TEXT") (8 . "sttkhu"))
	 )
)
(if ss
  (progn
    (setq lstenttext (acet-ss-to-list ss))
    (foreach ent lstenttext
      (or tsi (setq tsi (dxf 40 ent)))
      (if (null (distof (dxf 1 ent)))
	(progn
	  (setq	p1 (vlax-get (vlax-ename->vla-object ent) 'TextAlignmentPoint)
		p2  (vlax-curve-getClosestPointTo entlwp p1)
		ang (angle p1 p2)
		p3  (polar p1 ang (* tsi 1.2))
		dis (distance p2 p3)

	  )
	  (if (>= dis (* 2 tsi))
	    (progn
	      (leader p2 p3 tsi)
	    )
	    (progn
	      (setq p3 (polar p2 (- ang pi) (* tsi 2.1)))
	      (leader p2 p3 tsi)
	      (setq entle (entlast)
		    ss	  (acet-list-to-ss (list entle))
	      )
	      (setq
		p4 (acet-ss-drag-move
		     ss
		     p2
		     "\nMove Arrow to : "
		     1
		   )
	      )
	      (vla-move	objle
			(vlax-3d-point p2)
			(vlax-3d-point p4)
	      )
	    )
	  )
	)
      )
    )
  )
  (alert "khong co text nao!!!")
)
     )
   ); end if
 )
 (RESTORE)
 (vla-EndUndoMark ActDoc)
 (princ "\nThank you for use my lisp: svb_Arrow.lsp!")
 (princ)
)

  • Vote tăng 1

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

aliosa    4

aliosa
Đã đăng
Sau khi tham khảo các bài hướng dẫn của bác SSG, mình thử liều viết bổ sung vào cái lisp lb1.lsp viết cho bạn Ngolevietduc87 để có thể xuất dữ liệu vào một file excel. Vì đây là thử nghiệm lần đầu tiên nên rất mong các bác xem qua và góp ý nhé. Nó đây ạ:

Lưu ý khi sử dụng: Phải tạo trước một file excel trống với tên tùy ý rồi thoát khỏi Excel. Khi chạy lisp sẽ hiển thị bảng lựa chọn file để mở, browse dến tên file vừa lập và clickOk

Lisp sẽ tự động lập bảng kết quả cả trên bản vẽ và cả trên sheet hiện hành của file excel.

 

Bạn "PhamthanhBinh" viết lisp này rất hay rùi. Thực chất đây có lẽ là bài cắm cọc GPMB hoặc cắm Mốc lộ giới của tuyến đường.

Việc chuyển số liệu sang file excel theo mình nghĩ đơn giảm hơn chỉ cần ghi ra file dang .CSV là ổn rồi, như thế mình sẽ không phải khai báo file excel trước. Xuất ngay sang Excel cũng tốt nhưng hơi phức tạp một chút.

Xin nhờ các bạn giúp bổ sung thêm bài toán một chút nũa cho bài toán được hoàn chỉnh:

- Cho điểm đầu của polyline một giá trị (Lý trình đầu) bằng cách hỏi lý trình ở dòng lệnh

- Xác định lý trình tương ứng của các cọc giải phóng mặt bằng và ghi bổ sung thêm một lý trình sau cột stt.

Ví dụ:

- Cho điểm đầu tiên của polyline giá trị 100

- Lý trình của cọc đầu tiên là 123.75 (=100+23.75)

File minh họa: http://www.cadviet.com/upfiles/2/vidu_3.dwg

Cảm ơn các bạn về bài toán!

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

svba1608    627

svba1608
Đã đăng
Chào svba1608, Lisp này sẽ giúp cho svba1608 thêm mũi tên tạo dốc nước chảy. Tuy nhiên để cho lisp chạy 1 cách đầy đủ không bỏ sót thì các đường bao "ranh thửa" phải là đường kín (closed). Để biết 1 pline có closed hay không hãy pick chúng và xem cửa sổ property tại mục closed nó báo YES hay NO nếu NO thì chỉnh lại YES. Ngoài ra, vì chiễu mũi tên sẽ hướng từ điểm dóng của text ra đến điểm gần nhất của pline đường bao, nên các text A, B, C, D.. phải nằm gần đường ống hơn.

Cảm ơn anh Thiệp và anh Tuệ nhiều! (Anh Tue_NV cũng viết giùm em một lisp nhưng không hiểu vì sao chưa thấy post lên để cho em được cảm ơn :D )

Em đã dùng lisp anh Thiệp viết cho em thì thấy lisp chạy tốt, tuy nhiên thỉnh thoảng nó lại hỏi: "Move arrow to", em không hiểu vì sao.

Về yêu cầu các text phải nằm gần đường ống hơn thì em không thực hiện được vì em phải viết các thông số khác trên đường ống, bao gồm 6 thông số: chiều dài, lưu lượng, đường kính, độ dốc, vận tốc, tổn thất. 3 thông số bên trên và 3 thông số bên dưới, nếu để các text gần đường ống sẽ che mất các thông số cần viết.

Chào anh! Cảm ơn anh rất nhiều!

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
Cảm ơn bác Bình rất nhiều, em đã chạy thử lisp bác viết cho, chạy ổn cả, nhưng vẫn chưa đúng mục đích của em lắm. Mục đích của em là khi pick vào đường PL đó thì sẽ in được toạ độ x=.., y=..., z=... lên bản vẽ tại chính vị trí point đó và đồng thời xuất dữ liệu ra file txt. Em nhờ các bác giúp cho, em đang rất cần. Em đang có một đường PL khoảng 600 point mà không có các bác giúp chắc em chết!!! Thanks các bác nhiều!!!

Hề hề hề, chào bạn sucuph,

Việc này không khó chỉ cần bạn thêm vào đoạn code:

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (rtos (caddr p) 2 2)))))

các mã như sau:

"X=" phía trước (rtos (car p) 2 2)

"Y=" phía trước (rtos (cadr p) 2 2)

"Z=" phía trước (rtos (caddr p) 2 2)

và các dấu "," vào trong các khoảng trắng

để thành:

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat "X=" (rtos (car p) 2 2) ", " "Y=" (rtos (cadr p) 2 2) ", " "Z=" (rtos (caddr p) 2 2)))))

là Ok thôi mà.

Bạn hãy thử xem nhé. Hề hề hề........

Còn việc xuất dữ liệu ra file text mình chưa hiểu rõ ý bạn lắm, bạn có thể đưa ra cái nội dung file text của bạn muốn có được không???? File text bạn muốn là ở dạng file gì??? txt, doc, csv.....???

Cái bảng kết quả nếu bạn thấy không cần thiết có thể vô hiệu hóa các dòng code tạo bảng đi bằng các đưa vào phía trước nó các dấu ";" bạn ạ.

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

thiep    365

thiep
Đã đăng
Cảm ơn anh Thiệp và anh Tuệ nhiều! (Anh Tue_NV cũng viết giùm em một lisp nhưng không hiểu vì sao chưa thấy post lên để cho em được cảm ơn :cheers: )

Em đã dùng lisp anh Thiệp viết cho em thì thấy lisp chạy tốt, tuy nhiên thỉnh thoảng nó lại hỏi: "Move arrow to", em không hiểu vì sao.

Về yêu cầu các text phải nằm gần đường ống hơn thì em không thực hiện được vì em phải viết các thông số khác trên đường ống, bao gồm 6 thông số: chiều dài, lưu lượng, đường kính, độ dốc, vận tốc, tổn thất. 3 thông số bên trên và 3 thông số bên dưới, nếu để các text gần đường ống sẽ che mất các thông số cần viết.

Chào anh! Cảm ơn anh rất nhiều!

Chào svba,

- "Move arrow to" là vì có những chỗ vị trí từ tâm của text đến đường bao quá ngắn nên lisp yêu cầu người dùng di dời mũi tên đến chỗ nào khác ấy mà! Máy tính nó cũng thông minh đấy chứ!.

- Nếu không dịch text vào ra 1 chút gần đường ống thì mũi tên đôi khi nó chỉ sang hướng khác mất!. Đôi khi máy tính nó cũng ngu ghê! :D

  • Vote tăng 2

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

sucuph    1

sucuph
Đã đăng

cảm ơn bác Bình lần nữa nha, em chạy ổn cả rồi, còn việc xuất ra file text nhờ bác hộ em cho ra file txt hoặc xls với 4 cột như bác đã làm, STT, X, Y, Z. Em về lisp thì mù tịt nên mong các bác thông cảm rồi dần dần em sẽ học hỏi thêm. À nhân tiện nhờ bác chỉnh hộ em toạ độ tại mỗi point thành 3 dòng text x=..., y=..., z=... cho nó đẹp.

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
cảm ơn bác Bình lần nữa nha, em chạy ổn cả rồi, còn việc xuất ra file text nhờ bác hộ em cho ra file txt hoặc xls với 4 cột như bác đã làm, STT, X, Y, Z. Em về lisp thì mù tịt nên mong các bác thông cảm rồi dần dần em sẽ học hỏi thêm. À nhân tiện nhờ bác chỉnh hộ em toạ độ tại mỗi point thành 3 dòng text x=..., y=..., z=... cho nó đẹp.

Chào bạn Sucuph,

Để chuyển thành "3 dòng text cho nó đẹp bạn hãy làm như sau:

Thay thế đoạn code:

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat "X=" (rtos (car p) 2 2) ", " "Y=" (rtos (cadr p) 2 2) ", " "Z=" (rtos (caddr p) 2 2)))))

Bằng 3 đoạn code sau:

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat "X=" (rtos (car p) 2 2)))))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)

(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)

(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))

Vậy là OK bạn ạ.

Còn việc xuất các kết quả này ra file *.txt hay file *.xls bạn phải chờ một chút vì mình vẫn chưa thành thục lắm bạn ạ. Mới đang thử lần mò thôi, phải vừa làm vừa dò nên không nhanh được, Mong bạn thông cảm.

Chúc bạn vui.

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

sucuph    1

sucuph
Đã đăng

sao em thử không được bác Bình ơi, kết quả vẫn như lisp trước

 

(defun c:lb2 ()

(vl-load-com)

(command "undo" "be")

(setq en (entsel "\n Chon pline ")

ob (vlax-ename->vla-object (car en))

n (vlax-curve-getEndParam ob)

i 0

li1 (list)

)

(setq pb (getpoint "\n Chon diem dat bang")

h (getreal "\n Nhap chieu cao chu: ")

k (getreal "\n Nhap do rong cot: ")

)

(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Z")))

(while (<= i n)

(setq p (vlax-curve-getPointAtParam ob i)

li1 (append li1 (list p))

y (- (cadr pb) (* (+ 2 i) 1.5 h))

)

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (rtos (caddr p) 2 2)))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (rtos (1+ i) 2 0))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))

(setq i (1+ i))

)

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat "X=" (rtos (car p) 2 2)))))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)

(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)

(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))

(command "undo" "e")

(princ)

)

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
sao em thử không được bác Bình ơi, kết quả vẫn như lisp trước

 

(defun c:lb2 ()

(vl-load-com)

(command "undo" "be")

(setq en (entsel "\n Chon pline ")

ob (vlax-ename->vla-object (car en))

n (vlax-curve-getEndParam ob)

i 0

li1 (list)

)

(setq pb (getpoint "\n Chon diem dat bang")

h (getreal "\n Nhap chieu cao chu: ")

k (getreal "\n Nhap do rong cot: ")

)

(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Z")))

(while (

(setq p (vlax-curve-getPointAtParam ob i)

li1 (append li1 (list p))

y (- (cadr pb) (* (+ 2 i) 1.5 h))

)

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (rtos (caddr p) 2 2)))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1 (rtos (1+ i) 2 0))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))

(entmake

(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))

(setq i (1+ i))

)

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)

(cons 1 (strcat "X=" (rtos (car p) 2 2)))))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)

(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))

(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)

(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))

(command "undo" "e")

(princ)

)

Hề hề hề,

Tại bạn quên cái mình hướng dẫn đấy mà. Mình bảo thay thế đoạn code ..... bằng 3 đoạn code sau, chứ có phải là thêm nó vào dưới đâu. Hề hề hề....

Việc bạn thêm nó vào cuối chỉ có tác dụng cho cái điểm cuối cùng thôi vì lúc này vòng lặp While đã thoát lisp chỉ còn nhớ mỗi điểm p cuối cùng mà thôi. Hề hề hề.

Bạn làm lại đi nha.

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
cái đó em biết chứ, vẫn không được mà, bác Bình chạy thử hộ em xem

Hề hề hê,

Mình chạy thử rồi, nó đây nè bạn:

Kết quả chạy:

http://www.cadviet.com/upfiles/2/lb2.jpg

lb2.jpg

Còn đây là cái lisp đã sửa nè:

(defun c:lb2 ()
(vl-load-com)
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Y")))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "Z")))
(while ((setq p (vlax-curve-getPointAtParam ob i) 
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat "X=" (rtos (car p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)
(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)
(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1  (rtos (1+ i) 2 0))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake 
(list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
(princ)
)

 

Hề hề hề, bạn xem xem có giống cái bạn đã sửa không hỉ????

  • Vote tăng 1

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

missyoutd01    0

missyoutd01
Đã đăng
Chào bạn missyoutd01

Trước hết bạn đọc các bài viết trong Topic này nhé :

http://www.cadviet.com/forum/index.php?showtopic=15978

Và bạn hãy thực hiện các lệnh trong đó và coi thử bạn có đáp ứng yêu cầu của bạn hay không? Và có gì chưa được thì bạn hãy post vào trong topic đó luôn nhé. . Tue_NV sẽ trả lời bạn ngay chính trong topic đó. OK?

 

Gợi ý : Yêu cầu của bạn giải quyết bằng 3 lệnh : BEDIT, WIPEOUT và DRAWORDER

Chúc bạn thành công

 

Cảm ơn bạn Tue_NV mình đã làm được theo cách của bạn 1lần nữa xin cám ơn bạn rất nhiều! :D

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

ngocanh1929@yahoo.com    0

ngocanh1929@yahoo.com
Đã đăng
Sử dụng lệnh DIMORDINATE

 

 

 

Chào bác Tue_NV !Thấy bác ở đây e tiện hỏi. Trước đây hình như em có lần từng đọc bài viết của bác có nội dung : ...làm nổi layer mà bị layer khác đè nên...

Em tìm mấy vòng mà vẫn chưa thấy...A giúp em vụ này nhé

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
em chạy được rồi, cảm ơn bác nha!

Chào bạn Sucuph,

Sau một hồi lần sờ, mình mót được của bác phi-phi cái lisp xuất tọa độ ra file *.txt, *.csv, *.xls. Thế là đem về bổ ra xơi, thấy xơ nhiều nạc ít, giắt răng muốn chết. Vậy nhưng cũng gặm được một chút. Nhờ đó có cái ghép vô với cái lisp lb2.lsp mà mình đã gửi bạn để cho ra được một cô em khá kháu khỉnh.

Bạn thử xài xem nhé:

(defun c:lb2 ()
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;
(defun text-draw (txt pnt height rotation justification)
  (if (null pnt)(command "_.-TEXT" "" txt)
  (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
   0.0
      ) ;_ end of =
    (progn
          (if justification
  (command "_.-TEXT" "_J" justification "_none" pnt height rotation txt)
  (command "_.-TEXT" "_none" pnt height rotation txt)
      ) ;_ end of if
    ) ;_ end of progn
    (progn
            (if justification
  (command "_.-TEXT" "_J" justification "_none" pnt rotation txt)
  (command "_.-TEXT" "_none" pnt rotation txt)
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
    )
 (entlast)
);;;;; End of defun text-draw
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
 TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
 Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
 (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
 (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
   (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
         *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
              *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
             *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
         *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
              *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                 (vl-filename-base(getvar "DWGNAME"))
                 (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
  col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) 
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 

"Y")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 

"Z")))
(while ((setq p (vlax-curve-getPointAtParam ob i) 
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat "X=" (rtos (car p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)
(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)
(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1  (rtos (1+ i) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
li1
(command "undo" "be")
(if li1 
(progn 
(setq li1 (mapcar '(lambda(x)(trans x 0 1)) li1))
(mapcar '(lambda(x) (princ (strcat "\n" (rtos(car x)) "," (rtos(cadr x))
(if (= 3(length x)) (strcat "," (rtos(nth 2 x))) "") ;;; End of if
))) li1);;; end mapcar
(setq Npt (getint"\n Chon so bat dau danh thu tu cac diem  : " )) 
(initget "Ôàéë Excel Íå Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword "\n Ban muon luu toa do vao dang file [Text file/Excel/Not save]  : ")) 
(if (null sFlag)
(setq sFlag "Text")
);;;;; End of if
(setq oFlag Npt)
(if (numberp Npt)
(foreach ln li1
 (text-draw                 
   (itoa Npt)               
   (polar ln (-(/ pi 2)) 2.5)   
   (setq h 1)      
   0                        
   nil
   ) ;;;; End of text-draw
 (setq Npt (1+ Npt))
) ;;;; End of foreach
) ;;;; End of if
(setq Npt oFlag)    
(setq li1 (mapcar '(lambda(x)(mapcar 'rtos x)) li1))
(cond 
(
(and 
(= "Text" sFlag)
(setq filPath (getfiled "Save Coordinates to Text File"  "Coordinates.txt" "txt;csv" 33))
) ;;; End of and
      (setq cFile (open filPath "w"))
(foreach ln li1
(write-line 
(strcat (if (numberp Npt)(strcat (itoa Npt) ",") "")(car ln)","(cadr ln) (if (= 3 (length ln)) (strcat ","(nth 2 ln)))) 
cFile)
(if (numberp Npt)
(setq Npt (1+ Npt))
);;; End of if
);;;; End of foreach
(close cFile)
(initget "Yes No")
(setq oFlag (getkword  "\nOpen text file? [Yes/No]  : " ))   
      (if (= oFlag "Yes") (startapp "notepad.exe" filPath))
); end condition #1
((= "Excel" sFlag)
(if (numberp Npt)
(progn
     (setq li1 (mapcar '(lambda(x) (cons (1- (setq Npt (1+ Npt))) x)) li1))
     (xls li1 '("N" "X" "Y" "Z") nil "COORN")
);;;; End of progn
     (xls li1 nil nil "COOR")) ;;;; End of if
); end condition #2
    (t nil) ;;; End of last condition
) ;;; End of cond
) ;;; End of progn
) ;;; End of if
(command "undo" "e")
(princ)
)

 

Cô em này tuy vậy nhưng với mình là khá khó trị, bác nào có nhã hứng thử tìm cách trị cho được theo ý muốn của mình đi nhé.

Cái vụ tự dưng đổi tên cái "Sheet1" thành "VD2-1&Coorn" mình vẫn chưa thể mò ra do cái hàm (xls......) nó rậm rì rắc rối và sâu hun hút, chả biết đâu mà mò. Thôi thì cứ biết khoái đến đó đã vậy.

Cái việc sau khi chạy lisp xong xuất hiện các text đánh số thứ tự của các điểm trên bản vẽ, lúc đầu mình định cắt béng nó đi, nhưng sau nghĩ lại thấy rằng âu cũng là việc cần vì đôi khi có người lại muốn đánh số thứ tự từ .... trên giời thì sao. Nếu không thích ta chỉ việc vô hiệu hóa cái hàm (text-draw .....) là ok.

Cái vụ lisp cứ tự động tắt file *.txt, *.csv sau khi ghi file rồ sau đó lại hỏi có cần mở không thực ra mình cũng thấy hơi nghịch mắt, xong cứ tôn trọng người đã viết ra nó vì có thể có cái lý ông sự ở đó. Tuy nhiên nếu không muốn quá loằng ngoằng như vậy thì các bạn có thể vô hiệu hóa cái đoạn code từ (close cFile) cho tới trước cái ngoặc (;;; end of condition #1)kết thúc điều kiện thứ nhất của hàm (cond .....).

Khi lisp chạy dừng lại để bạn chọn tên file *.txt sẽ lưu dữ liệu, mặc định là file Coordinates.txt nhưng bạn có thể đổi thành file *.txt hay *.csv thoải mái.

Túm lại ở cô em này còn nhiều điều đáng để khám phá. Tuy nhiên phải tùy vào khả năng của mỗi chiến sĩ nhà ta mà cái sự khám phá này cũng như cái sự khoái nó được nhiều hay ít. Với mình thế này là đã khoái rồi dù mới chỉ sơ sơ được một tý bên ngoài. Muốn khoái nữa chắc còn phải tích cóp ít công lực về lisp nữa mới ăn thua các bác ạ.

Chúc cả nhà vui vẻ, hề hề hề ......

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

sucuph    1

sucuph
Đã đăng
Chào bạn Sucuph,

Sau một hồi lần sờ, mình mót được của bác phi-phi cái lisp xuất tọa độ ra file *.txt, *.csv, *.xls. Thế là đem về bổ ra xơi, thấy xơ nhiều nạc ít, giắt răng muốn chết. Vậy nhưng cũng gặm được một chút. Nhờ đó có cái ghép vô với cái lisp lb2.lsp mà mình đã gửi bạn để cho ra được một cô em khá kháu khỉnh.

Bạn thử xài xem nhé:

(defun c:lb2 ()
(vl-load-com)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;
(defun text-draw (txt pnt height rotation justification)
  (if (null pnt)(command "_.-TEXT" "" txt)
  (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
   0.0
      ) ;_ end of =
    (progn
          (if justification
  (command "_.-TEXT" "_J" justification "_none" pnt height rotation txt)
  (command "_.-TEXT" "_none" pnt height rotation txt)
      ) ;_ end of if
    ) ;_ end of progn
    (progn
            (if justification
  (command "_.-TEXT" "_J" justification "_none" pnt rotation txt)
  (command "_.-TEXT" "_none" pnt rotation txt)
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
    )
 (entlast)
);;;;; End of defun text-draw
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
 TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
 Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
 (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
 (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
   (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
         *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
              *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
             *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
         *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
              *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                 (vl-filename-base(getvar "DWGNAME"))
                 (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
  col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." 
(substr Name_list (- (strlen Name_list) 13) 14))))
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) 
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
   (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* 
*New-Book* *Books-Colection**AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(command "undo" "be")
(setq en (entsel "\n Chon pline ")
ob (vlax-ename->vla-object (car en))
n (vlax-curve-getEndParam ob)
i 0
li1 (list)
)
(setq pb (getpoint "\n Chon diem dat bang")
h (getreal "\n Nhap chieu cao chu: ")
k (getreal "\n Nhap do rong cot: ")
)
(entmake (list (cons 0 "TEXT") (cons 10 pb) (cons 40 h) (cons 1 "BANG KET QUA")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "STT")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 "X")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 

"Y")))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) (- (cadr pb) (* 1.5 h)))) (cons 40 h) (cons 1 

"Z")))
(while (<= i n)
(setq p (vlax-curve-getPointAtParam ob i) 
li1 (append li1 (list p))
y (- (cadr pb) (* (+ 2 i) 1.5 h))
)
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 5))) (cons 40 1.0)
(cons 1 (strcat "X=" (rtos (car p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (+ (cadr p) 2.5))) (cons 40 1.0)
(cons 1 (strcat "Y=" (rtos (cadr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car p) (cadr p))) (cons 40 1.0)
(cons 1 (strcat "Z=" (rtos (caddr p) 2 2)))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (car pb) y)) (cons 40 h) (cons 1  (rtos (1+ i) 2 0))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) k) y)) (cons 40 h) (cons 1 (rtos (car p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 2 k)) y)) (cons 40 h) (cons 1 (rtos (cadr p ) 2 2))))
(entmake (list (cons 0 "TEXT") (cons 10 (list (+ (car pb) (* 3 k)) y)) (cons 40 h) (cons 1 (rtos (caddr p) 2 2))))
(setq i (1+ i))
)
(command "undo" "e")
li1
(command "undo" "be")
(if li1 
(progn 
(setq li1 (mapcar '(lambda(x)(trans x 0 1)) li1))
(mapcar '(lambda(x) (princ (strcat "\n" (rtos(car x)) "," (rtos(cadr x))
(if (= 3(length x)) (strcat "," (rtos(nth 2 x))) "") ;;; End of if
))) li1);;; end mapcar
(setq Npt (getint"\n Chon so bat dau danh thu tu cac diem  : " )) 
(initget "Ôàéë Excel Íå Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword "\n Ban muon luu toa do vao dang file [Text file/Excel/Not save]  : ")) 
(if (null sFlag)
(setq sFlag "Text")
);;;;; End of if
(setq oFlag Npt)
(if (numberp Npt)
(foreach ln li1
 (text-draw                 
   (itoa Npt)               
   (polar ln (-(/ pi 2)) 2.5)   
   (setq h 1)      
   0                        
   nil
   ) ;;;; End of text-draw
 (setq Npt (1+ Npt))
) ;;;; End of foreach
) ;;;; End of if
(setq Npt oFlag)    
(setq li1 (mapcar '(lambda(x)(mapcar 'rtos x)) li1))
(cond 
(
(and 
(= "Text" sFlag)
(setq filPath (getfiled "Save Coordinates to Text File"  "Coordinates.txt" "txt;csv" 33))
) ;;; End of and
      (setq cFile (open filPath "w"))
(foreach ln li1
(write-line 
(strcat (if (numberp Npt)(strcat (itoa Npt) ",") "")(car ln)","(cadr ln) (if (= 3 (length ln)) 
(strcat ","(nth 2 ln)))) cFile)
(if (numberp Npt)
(setq Npt (1+ Npt))
);;; End of if
);;;; End of foreach
(close cFile)
(initget "Yes No")
(setq oFlag (getkword  "\nOpen text file? [Yes/No]  : " ))   
      (if (= oFlag "Yes") (startapp "notepad.exe" filPath))
); end condition #1
((= "Excel" sFlag)
(if (numberp Npt)
(progn
     (setq li1 (mapcar '(lambda(x) (cons (1- (setq Npt (1+ Npt))) x)) li1))
     (xls li1 '("N" "X" "Y" "Z") nil "COORN")
);;;; End of progn
     (xls li1 nil nil "COOR")) ;;;; End of if
); end condition #2
    (t nil) ;;; End of last condition
) ;;; End of cond
) ;;; End of progn
) ;;; End of if
(command "undo" "e")
(princ)
)

 

Cô em này tuy vậy nhưng với mình là khá khó trị, bác nào có nhã hứng thử tìm cách trị cho được theo ý muốn của mình đi nhé.

Cái vụ tự dưng đổi tên cái "Sheet1" thành "VD2-1&Coorn" mình vẫn chưa thể mò ra do cái hàm (xls......) nó rậm rì rắc rối và sâu hun hút, chả biết đâu mà mò. Thôi thì cứ biết khoái đến đó đã vậy.

Cái việc sau khi chạy lisp xong xuất hiện các text đánh số thứ tự của các điểm trên bản vẽ, lúc đầu mình định cắt béng nó đi, nhưng sau nghĩ lại thấy rằng âu cũng là việc cần vì đôi khi có người lại muốn đánh số thứ tự từ .... trên giời thì sao. Nếu không thích ta chỉ việc vô hiệu hóa cái hàm (text-draw .....) là ok.

Cái vụ lisp cứ tự động tắt file *.txt, *.csv sau khi ghi file rồ sau đó lại hỏi có cần mở không thực ra mình cũng thấy hơi nghịch mắt, xong cứ tôn trọng người đã viết ra nó vì có thể có cái lý ông sự ở đó. Tuy nhiên nếu không muốn quá loằng ngoằng như vậy thì các bạn có thể vô hiệu hóa cái đoạn code từ (close cFile) cho tới trước cái ngoặc (;;; end of condition #1)kết thúc điều kiện thứ nhất của hàm (cond .....).

Khi lisp chạy dừng lại để bạn chọn tên file *.txt sẽ lưu dữ liệu, mặc định là file Coordinates.txt nhưng bạn có thể đổi thành file *.txt hay *.csv thoải mái.

Túm lại ở cô em này còn nhiều điều đáng để khám phá. Tuy nhiên phải tùy vào khả năng của mỗi chiến sĩ nhà ta mà cái sự khám phá này cũng như cái sự khoái nó được nhiều hay ít. Với mình thế này là đã khoái rồi dù mới chỉ sơ sơ được một tý bên ngoài. Muốn khoái nữa chắc còn phải tích cóp ít công lực về lisp nữa mới ăn thua các bác ạ.

Chúc cả nhà vui vẻ, hề hề hề ......

Oài, cái này phức tạp ghê, bác ghép cho em vào cái lisp lb2 đi, em nhìn vào mù tịt chả biết gì, hihi

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

foudremars    3

foudremars
Đã đăng

Em đang san nền bằng Lisp ô lưới. Mình phải đo cao độ tự nhiên tại các nút của ô lưới bằng lệnh CDTN trong Nova. Sau đó lấy cao độ đo được nhập tay vào 1 Text đã có sẵn ở gần nút lưới. Các bác có Lisp nào hoặc viết hộ em 1 Lisp mà sau khi đo CDTN, Pick vào 1 Text thì nó sẽ thay nội dung của Text đó bằng cao độ vừa đo được. (Nó gần giống như Lisp đo diện tích). Cảm ơn các bác rất nhiều!

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
Khách
Chủ đề này bây giờ đã bị đóng lại để trả lời thêm.
Về Đầu Trang AutoLisp
×