Chuyển đến nội dung
Diễn đàn CADViet
Jin Yong

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

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

- hi sr anh nhoc lộn, nhoc mot của sư huynh Hiep, chưa đọc kỹ , chỉ entmod đc điểm đầu or cả lstdxf10 ^^

(defun k_entmod (ten lst_new / lstcu)
(setq lstcu (entget ten))
(cond
	((= (cdr (assoc 0 lstcu)) "MTEXT")
		(foreach x lst_new
			(if (= (car x) 1) (setq lstcu (subst x (assoc 1 lstcu) lstcu)) (setq lstcu (append lstcu (list x))))))
	((= (cdr (assoc 0 lstcu)) "*POLYLINE")
		(foreach x lst_new
			(if (= (car x) 10) (setq lstcu (subst x (assoc 10 lstcu) lstcu)) (setq lstcu (append lstcu (list x)))))
					)
	
	(t (setq lstcu (append lstcu lst_new)))
)
(entmod lstcu)
)
  • 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

 

Thanks bác Tue_NV, quay lại vấn đề đoạn thẳng trùng nhau (nằm đè lên nhau), em mới chỉ nghĩ ra được điều kiện để kiểm tra như sau:

-Tính chiều dài các đoạn thẳng

- Sắp xếp theo thứ tự chiều dài nhỏ dần trong list bằng vl-sort

-Dùng hàm của bác thanhduan247 ở trên để kiểm tra điều kiện:

Chiều dài đoạn thẳng lớn hơn = [tổng khoảng cách của các đầu đoạn thẳng lớn đến các đầu đoạn thẳng nhỏ

                                                                                                                       hoặc đến các đầu của (reverse của đoạn thẳng nhỏ)]

                                                     + với chiều dài đoạn thẳng nhỏ

                                                                                                                      kèm sai số.

Nếu chỉ là đoạn thẳng thì mình nghĩ bạn nên làm thế này :

- Đầu vào là tập Line bất kỳ

- Foreach từng Line để nhóm các Line có Angle dxf 10, 11 trùng nhau hoặc chênh nhau 180 độ vào 1 nhóm, theo dạng này :

( (goc1 . (Line1 Line2 Line3 ..)(goc 2 . (Line4 Line5 ...))

- Viết hàm con xử lý đám màu đỏ kia. Cách dễ nhất là giữ thằng to lại, xóa tiệt thằng nhỏ đi. Còn có yêu cầu khác thì bạn xử lý ^^

- Cuối cùng là mapcar

Nếu sử dụng các hàm vl thì code cũng gọn thôi, ít nhất là hơn trước ^^

  • 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

@Thanhduan: em "lão luyện" trong việc post bài rồi mà cứ post kiểu "Cám ơn. Để test xem sao" hoặc "Thanks" khi nhận được một ý kiến trả lời. Thay vì vậy chỉ cần nhấn like là đủ, để tránh bắt người khác phải đọc 1 nội dung "không có gì".

@Ket:

1). Có những cặp Line có góc bằng nhau nhưng không đè lên nhau?

2). Liệu có thể viết được danh sách gồm các item kiểu (goc . list) không?

  • 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

@bác :

1. Chính là việc phải xử lý trong hàm con riêng. Việc xếp này giúp hạn chế số lần kiểm tra thôi ạ.

2. Không. Cháu viết dấu . để trinhhoanghieu phân biệt 2 phần tử này. Thực chất được tạo nên bở list list, k cons, nhưng vẫn lấy được assoc như thường, vì nó chính là 1 associative list. Cái này mấy post trước vừa có xong

  • 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

Thanks thầy ketxu và bác gia bạch đã quan tâm  đến vấn đề của em nhiệt tình như vậy. Vì phần xoá line trùng này chỉ là "bộ lọc" cho một cái lisp mà em dùng áp dụng cho công việc, theo sự "chỉ điểm" của bác Tue_NV em "mót" lại hàm con này trên  diễn đàn và chế lại theo nhu cầu:

(defun xoalinetrung (lst / lst1)
(setq lst1 (list (car lst)))
(while lst
	(setq lst (cdr lst)
		x (last lst1))
	(foreach y lst
		(if (and
		      (equal (+ (distance (car x) (car y)) (distance (car y) (cadr x))) (distance (car x) (cadr x)) 0.002)
		      (equal (+ (distance (car x) (cadr y)) (distance (cadr y) (cadr x))) (distance (car x) (cadr x)) 0.002)
		    )
		(setq lst (vl-remove y lst))
		)
	)
	(setq lst1 (append lst1 (list (car lst))))
)
(vl-remove-if '(lambda (x) (= x nil)) lst1)
)

Đầu tiên em áp dụng cho toàn bộ tập đường thẳng đã xoá bỏ lại toàn bộ các mã dxf râu ria và còn lại list là danh sách toạ độ có dạng 

 

 

(  ( (xdau1 ydau1 0) ((xsau1 ysau1 0) )....)
 

 

Thanks bác Tue_NV, quay lại vấn đề đoạn thẳng trùng nhau (nằm đè lên nhau), em mới chỉ nghĩ ra được điều kiện để kiểm tra như sau:

-Tính chiều dài các đoạn thẳng

- Sắp xếp theo thứ tự chiều dài nhỏ dần trong list bằng vl-sort

-Dùng hàm của bác thanhduan247 ở trên để kiểm tra điều kiện:

Chiều dài đoạn thẳng lớn hơn = [tổng khoảng cách của các đầu đoạn thẳng lớn đến các đầu đoạn thẳng nhỏ

                                                                                                                       hoặc đến các đầu của (reverse của đoạn thẳng nhỏ)]

                                                     + với chiều dài đoạn thẳng nhỏ

                                                                                                                      kèm sai số.

Nếu chỉ là đoạn thẳng thì mình nghĩ bạn nên làm thế này :

- Đầu vào là tập Line bất kỳ

- Foreach từng Line để nhóm các Line có Angle dxf 10, 11 trùng nhau hoặc chênh nhau 180 độ vào 1 nhóm, theo dạng này :

( (goc1 . (Line1 Line2 Line3 ..)(goc 2 . (Line4 Line5 ...))

- Viết hàm con xử lý đám màu đỏ kia. Cách dễ nhất là giữ thằng to lại, xóa tiệt thằng nhỏ đi. Còn có yêu cầu khác thì bạn xử lý ^^

- Cuối cùng là mapcar

Nếu sử dụng các hàm vl thì code cũng gọn thôi, ít nhất là hơn trước ^^

Để em áp dụng ý tưởng chia để trị này tăng tốc cho lisp, tuy không giống hoàn toàn nhưng chắc cũng chạy nhanh lên được kha khá :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

Nếu chia để trị thì phân thành các nhóm line nằm trên các đường thẳng có pt:

ax + by + c = 0

Với a^2 + b^2 = 1

=> bài toán 1 chiề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

Mọi người làm ơn cho mình hỏi ý nghĩa của lệnh này không

(vlax-curve-getEndParam curve-obj)....Thông số cuối của đường cong

và còn khoảng 10 câu lệnh có liên quan đến Param của Curve nữa nhưng ,sẽ mình sẽ tự tìm hiểu sau:

Mình muốn hỏi.

1. Thế nào là đường cong, đối tượng nào được chấp nhận là đường cong?

2. Ý nghĩa của Param( trong Google dịch là tham số) của đường cong Curve là gì?

Mình thấy.

Với PolyLine nó có Max là số đỉnh của Pl nhưng lại nhận được các số thực < Max

Với Circle,ELLIP có Max là 2*pi, chấp nhận số thực nhở, lớn hơn 2*pi

Với Line nó là chiều dài Line, không có Max

Với Arc, mình chưa tìm hiểu được.

Với Spline mình cũng chưa tìm hiểu được.

<min=0>

cảm ơn mọi người

P/s Mình thắc mắc tại sao các thành viên Mod của Cadviet thì member thường không gửi tin nhắn riêng được nhỉ,

Chỉnh sửa theo quansla

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

Mình biết thì như này:

1.Các hàm vlax-curve thì áp dụng cho các đối tượng dạng tuyến : line, arc, circle, pline .v.v.

2.Các hàm này không mang tính tuyệt đối (có sai số).

3.Khi đã dùng tới tụi nó tính ưng ý và ổn định của chương trình rất không cao.

  • 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

Mình biết thì như này:

1.Các hàm vlax-curve thì áp dụng cho các đối tượng dạng tuyến : line, arc, circle, pline .v.v.

2.Các hàm này không mang tính tuyệt đối (có sai số).

3.Khi đã dùng tới tụi nó tính ưng ý và ổn định của chương trình rất không cao.

Cảm ơn bác nhé, có điều câu lệnh về tham số đường cong nhiều như vậy mà không dùng được thì có vẻ hơi phí

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

1. Các curve trong cad gồm : arc, circle, polyline, line, donut, ellipse, spline và Helix (ống xoắn)

2. Những param bạn nói trên là đúng, bổ sung với arc : Startparam là dxf 50, endparam là dxf 51.

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

Các bác ơi cho em hỏi chút, em muốn tự động mở file cad lên khi gõ lệnh lisp nhưng không được,  file cad cần load em đã để trong support file search, code em viết đây ạ, vấn đề ở chỗ hàm open, khi gõ trực tiếp trên command thì được mà viết vào lisp thì lại không được:

(defun c:wgs84_105 ()
(defun start ()
(setvar "filedia" 0)
)
(defun end ()
(setvar "filedia" 1)
)
(defun *error* ( aaa)
 (end)
 )
 (start )
(command "open" "WGS84_105") 
 (end )
)

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

- open = command không có đối số nên không thể viết open = command trong lsp đc ^^, mún mở file nhoc nhớ loáng thoáng có xem đâu đó chỉ có thể dùng hàm

vla-xxx, hay dùng lệnh scrip của cad

  • 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

- open = command không có đối số nên không thể viết open = command trong lsp đc ^^, mún mở file nhoc nhớ loáng thoáng có xem đâu đó chỉ có thể dùng hàm

vla-xxx, hay dùng lệnh scrip của cad

Nhóc ơi cố gắng nhớ xem là hàm nào giúp tớ với 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

- ah đây, mới mò lại ^^, filename phải khai rõ đường dẫn hen => Hieu không cần để file trong supports, readonly nếu để nil thì giống mở file bình thường cho save, còn khác nil thì mở file dạng read_only, múa vô tư nhưng ko save đc ^^

(defun MyOpen (FileName ReadOnly / )
(vla-Open
 (vla-get-Documents
  (vlax-get-Acad-Object)
 )
 FileName
 (if ReadOnly 
  :vlax-true
  :vlax-false
 )
)
)
  • 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

- open = command không có đối số nên không thể viết open = command trong lsp đc ^^, mún mở file nhoc nhớ loáng thoáng có xem đâu đó chỉ có thể dùng hàm

vla-xxx, hay dùng lệnh scrip của cad

 

Command "ai_editcustfile"

  • 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
Cách chạy file .exe (3 trong 1 chú ý thằng thứ 2 là chơi được nhiều loại file) 

:P :

(command "shell" "D:/xxx/run.exe")
(command "ai_editcustfile" "D:/xxx/run.exe")
(startapp "D:/xxx/run.exe")
  • 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

Chào các bác, hôm qua vào facbook của nhóm Cadmagic em "vớ" được lisp này của thầy ketxu và mang về "mông má" lại cho phù hợp với nhu cầu, giờ còn chút vấn đề nữa qua đây nhờ các bác chỉ giáo. Em nó đây:

(defun c:darr( / ST:Ss-Copy-Dynamic ST:SS->List-Vla ST:Ss-Delete ST:Check-Exist txt2num a b dir gr p0 px nx pxv ssFull ss1 vecx ans inc *error*)
(vl-load-com)
;==============================================================================================================
(defun ST:Ss-Copy-Dynamic ( sslst n v dir / i number number1 matlist obj1 ss transmat xobj isText lst isReal)
  (setq ss (ssadd))
  (foreach xobj sslst
	(setq i 1)
(cond	(	(wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText")
			(setq	lst (txt2num (vla-get-textstring xobj)) 
					number1 (cadr lst)
					number (read number1)
				)
			(setq isText T)
			) ;Text Object
		(T 	setq isText nil)
	); end cond tong 

	(repeat n
  	(setq obj1 (vla-copy xobj)
  		  matList (list (list 1 0 0 (* i (car v) dir)) (list 0 1 0 (* i (cadr v) dir)) '(0 0 1 0) '(0 0 0 1))
  		  transmat (vlax-tmatrix matlist))
		  
  	(vla-transformby obj1 transMat)
	
   (if  (and isText (wcmatch (vla-get-objectname xobj) "AcDbText,AcDbMText")) ; dieu kien tong
		(if (and (< number 9 ) (> (strlen number1) 1))
		
			(vla-put-textstring obj1 (strcat (car lst) "0" (rtos (setq number (1+ number)) 2 0) ))
			
			(vla-put-textstring obj1 (strcat (car lst) (rtos (setq number (1+ number)) 2 0) ))
			); end if
	 ); end if tong	 	 
	 
  	(ssadd (vlax-vla-object->ename obj1) ss)
  	(setq i (1+ i))
	)
  );end foreach
  ss 
)
;=============================================================
(defun ST:SS->List-Vla (ss / n e l)
  (setq n (sslength ss))
  (while (setq e (ssname ss (setq n (1- n))))
	(setq l (cons (vlax-ename->vla-object e) l))
  )
)
;=====================================================================
(defun ST:Ss-Delete (ss / i)
  (mapcar 'vla-delete (ST:SS->List-Vla ss))
)
(defun ST:Check-Exist(lst1 lst2)(and (vl-remove nil (mapcar '(lambda(x)(vl-position x lst2)) lst1)))) ;from topic Dovui ^^
 (defun *error* (msg)    
    (if ss1 (ST:ss-delete ss1))    
  )
(defun txt2num ( string / so m chuoi kytu ) ; tach cac so o cuoi chuoi
 
 (setq so " 0123456789"
       m (strlen string)
	   chuoi "")
(while (and (>= m 1) (vl-string-search (setq kytu (substr string m 1)) so ) )
	   (setq m (1- m))
	   (if (/= kytu " " ) (setq chuoi (strcat kytu chuoi)))
)
(list (substr string 1  m ) chuoi)
)
;;==============================================================================

(grtext -1 "Dynamic LArray")
(command "undo" "be")
(setq a (ssget "_+.:E:S" '((-4 . "<OR")
									(0 . "TEXT,MTEXT,LINE")
									(-4 . "<AND") (0 . "LWPOLYLINE") (70 . 0)(-4 . "AND>")
									(-4 . "OR>"))
			)
		)
(cond (	(and a
			(or
				(= (cdr(assoc 0 (entget(ssname a 0)))) "LWPOLYLINE,LINE")
				(= (cdr(assoc 0 (entget(ssname a 0)))) "LINE")
				)
			(setq	b (ssget "_+.:E:S" '((0 . "TEXT,MTEXT")) ))
			)
		(setq a (SSADD (ssname b 0) a))
		)
	 (	(and a
			(or
				(= (cdr(assoc 0 (entget(ssname a 0)))) "TEXT")
				(= (cdr(assoc 0 (entget(ssname a 0)))) "MTEXT")
				)
			(setq	b (ssget "_+.:E:S" '((0 . "LWPOLYLINE,LINE")) ))
			)
		(setq a (SSADD (ssname b 0) a))
		)
	);end cond
(if (setq	ssFull (ST:SS->List-Vla a)
			p0 (getpoint "\n\U+0110i\U+1EC3m g\U+1ED1c :")
			px (getpoint p0 "\nH\U+01B0\U+1EDBng v\U+00E0 kho\U+1EA3ng c\U+00E1ch copy :")
			vecx (mapcar '- px p0)
		)
(progn
  (prompt "\nPick \U+0111i\U+1EC3m cu\U+1ED1i c\U+00F9ng :")
  (while (= (car (setq gr (grread nil 5 0))) 5)
	(if ss1 (ST:Ss-Delete ss1))
	(redraw)
	(setq pxv (mapcar '- (inters (cadr gr) (polar (cadr gr) (+ (/ pi 2.0) (angle px p0)) 1.0) p0 px nil) p0))
	(if (< (setq nx  (fix (/ (caddr (trans pxv 0 vecx)) (caddr (trans vecx 0 vecx))))) 0)
     	  (setq dir -1 nx (- nx)) (setq dir 1))
 
	(setq ss1 (ST:Ss-Copy-Dynamic ssFull nx vecx dir)) ; can chu y doan nay;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	(grdraw p0 (mapcar '+ p0 pxv) 3 1)
  )
)
)
(command "undo" "en")
(princ)

)

File cad để test đây:

https://www.dropbox.com/s/ukl1kdw7klbmo7f/Drawing2.dwg?dl=0.

 

 Khi để UCS ở chế độ W thì lisp chạy ngon lành . Nhưng khi đặt lại UCS thì các đường thằng array không theo ý muốn nữa. Trong file test sau khi đặt UCS, em bật chế độ Ortho on, chọn đối tượng, pick điểm gốc, pick điẻm chọn khoảng cách và hướng copy thì nó toàn copy theo góc như chưa thay đổi UCS. :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

Nếu rỗi bạn đọc hàm trans

Quick fix thì đổi dòng setq vecx (mapcar ....) thành (trans (mapcar ...) 1 0 T), hệ lụy tự bạn check

Code viết lâu quá rồi, nhìn rối mắt :)

  • 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

Các bác ơi cho em hỏi muốn bật Polar Tracking tương đương với nút F10 thì mình dùng biến hệ thống nào ạ.

Em mò mãi trong help mới ra được biến polarmode để thay đổi từ chế độ Absolute về Relative To Last Segment thôi.

Nhân tiện cho em hỏi dòng chữ màu đỏ bắt đầu có từ phiên bản cad nào ạ. Em từ lâu tới giờ chung tình với em cad2007 nên không biết.

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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay


×