Đến nội dung


Hình ảnh
- - - - -

nhờ các anh sửa giúp lisp này như hình vẽ với ạ


  • Please log in to reply
11 replies to this topic

#1 phamitt

phamitt

    biết vẽ pline

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

Đã gửi 24 March 2015 - 06:16 PM

http://www.cadviet.c...39657_coorn.lsp

ví dụ như líp chạy ra tọa độ -14521.9 nhưng em muốn thành -14.522. Thanks các anh nhé

39657_cad_1.jpg


  • -1

#2 hainguyen2014

hainguyen2014

    biết vẽ arc

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

Đã gửi 24 March 2015 - 09:11 PM

File bị lỗi. Tôi không thể tải được. Vui lòng kiểm tra lại.
  • 0

#3 phamitt

phamitt

    biết vẽ pline

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

Đã gửi 25 March 2015 - 03:38 PM

Em tải lại file, anh sửa giúp em nhé. thanks anh nhiều

http://www.mediafire...9id97/COORN.LSP

Em tải file bị lỗi nên tải lên mediafine. Anh chịu khó copy link tải xuống cho em nhé.


  • 0

#4 phamitt

phamitt

    biết vẽ pline

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

Đã gửi 26 March 2015 - 09:28 AM

em nho bac 

hainguyen2014 sua giup cho em voi a. Em dang can gap. Thanks bac
  • 0

#5 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 26 March 2015 - 09:42 AM

-Cái này bạn nên yêu cầu muc đích cho công việc của bạn thì hay hơn chứ sửa cái lisp này thì chắc ít người giúp vì mọi người làm biến đọc cái lisp này nhìn hoa cả mắt


  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#6 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 26 March 2015 - 10:04 AM

Của bạn đây

(defun C:Pick ( / LOOP NDUNG P PNT TOADOX TOADOY)
(setq loop T)
(while loop
	(setq Pnt (getpoint (strcat "\nPick \U+0111i\U+1EC3m tr\U+00EAn m\U+00E0n h\U+00ECnh:  ")))
	(cond
		  (T
		    (if Pnt
			   (progn
				(setq toadoY (/ (cadr (trans Pnt 1 0)) 1000.0))
				(setq toadoX (/ (car (trans Pnt 1 0)) 1000.0))
			     	(setq Ndung (strcat " X = " (rtos toadoX 2 3) " Y = " (rtos toadoY 2 3)))
				(setq p (getpoint Pnt "\nCh\U+1ECDn v\U+1ECB tr\U+00ED : "))
				(command "LEADER" Pnt p "" "" "Mtext" Ndung "")
			   )
		   	   (setq loop nil)
		     )
		)
	)
)
(princ)
)

  • 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







#7 phamitt

phamitt

    biết vẽ pline

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

Đã gửi 26 March 2015 - 11:58 AM

Cam on cac bac nhe. Cam on bac 

thanhduan2407 nhung em muon xuat tat ca cac diem day sang file Excel co. Nho bac giup em them lan nua nhe. Thanks
  • 0

#8 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 26 March 2015 - 03:41 PM

Của bạn đây

http://www.cadviet.c...4/36665_tmp.lsp


  • 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







#9 phamitt

phamitt

    biết vẽ pline

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

Đã gửi 26 March 2015 - 04:26 PM

Ban 

thanhduan2407 co the dua giup minh len mediafire voi. link bi loi minh khong tai duoc ban a!
  • 0

#10 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 26 March 2015 - 06:57 PM

Của bạn đây

(defun C:Pick ( / LOOP NDUNG P PNT TOADOX TOADOY L1 L2)
(setq loop T)
(setq L2 (list))
(while loop
  	(setq L1 (list))
	(setq Pnt (getpoint (strcat "\nPick \U+0111i\U+1EC3m tr\U+00EAn m\U+00E0n h\U+00ECnh:  ")))
	(cond
		  (T
		    (if Pnt
			   (progn
				(setq toadoY (/ (cadr (trans Pnt 1 0)) 1000.0))
				(setq toadoX (/ (car (trans Pnt 1 0)) 1000.0))
			     	(setq L1 (list toadoX toadoY))
			     	(setq L2 (append L2 (list L1)))
			     	(setq Ndung (strcat " X = " (rtos toadoX 2 3) " Y = " (rtos toadoY 2 3)))
				(setq p (getpoint Pnt "\nCh\U+1ECDn v\U+1ECB tr\U+00ED : "))
				(command "LEADER" Pnt p "" "" "Mtext" Ndung "")
			   )
		   	   (setq loop nil)
		     )
		)
	)
)
(if (vlax-get-or-create-object "Excel.Application")
			(WriteToExcel L2)
			(WriteToCSV L2)
)
(princ)
)


(defun WriteToExcel (lst_data / col row x xlApp xlCells)
(setq xlApp (vlax-get-or-create-object "Excel.Application")
	xlCells (vlax-get-property
			(vlax-get-property
		  		(vlax-get-property
			    		(vlax-invoke-method
				   		(vlax-get-property xlApp "Workbooks")
			   						 "Add"
					)
					"Sheets"
				)
	  			"Item" 1
			)
			"Cells"
		)
)
(setq row 1)
(foreach pt lst_data
	(setq col 1)
	(foreach coor pt
  	(vlax-put-property xlCells 'Item row col coor)
  	(setq col (1+ col)))
	(setq row (1+ row))
)
(vla-put-visible xlApp :vlax-true)
(mapcar
	(function (lambda (x)
		  (vl-catch-all-apply (function (lambda ()(if x (vlax-release-object x))))))
        )
        (list xlCells xlApp)
)
(gc)
(gc)
)
 
(defun WriteToCSV (lst_data / fl)
(if (setq fl (getfiled "Output File" "" "csv" 1))
	(if (setq fl (open fl "w"))
		(progn
			(foreach pt lst_data
				(write-line (strcat (rtos (car pt)) "," (rtos (cadr pt)) "," (rtos (caddr pt))) fl)
			)
			(close fl)
		)
	)
)
(pr

  • 1



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







#11 phamitt

phamitt

    biết vẽ pline

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

Đã gửi 27 March 2015 - 08:24 AM

Cam on anh 

thanhduan2407 nhieu nhe
  • 0

#12 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 27 March 2015 - 10:10 AM

 

Cam on anh 

thanhduan2407 nhieu nhe 

Cảm ơn thì bạn nhấn nút  màu xanh bên dưới í. :D


  • 1



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