Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Jin Yong

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

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

nguyentuyen6    127

hì hì!!!

@ bác tu:

Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.

 

@bác Thanhbinh:

Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ gặm nốt con của bác luôn, hehe

 

E đang tét thử cái này thấy nó vẽ rectang ko chuẩn, không trùng vào cái rectang đã lấy đc entname kia là sao các bác nhỉ???

 

 

(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e )
;;Tra ve entname cua rec to nhat vao bien entrecblk
(vl-load-com)
(setq plst '() Ld '() ldent '())
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
	(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE") 
    (setq s (cdr (assoc 2 (entget blk))))
    (setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
	(setq plst (append plst (list e)))
	(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
	(setq Ld '())
	(FOREACH x dsd 
	    (setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
	)
	(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
		 (>= (cdr(assoc 90 el)) 3)
		 (vlax-curve-isClosed e)
		 (null (ssget "WP" Ld))
	    )
		 (setq Ldent (append Ldent (list e)))
	)
                (setq e (entnext e))  
            )
(if (> (length Ldent) 0)
 (progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x)) 
					   (vla-get-area (vlax-ename->vla-object y))
					)
			   )
	     ))	
   (setq entrecblk (car Ldent))
 )
)
   (command "erase" xp "")
    (command ".UNDO" "E")
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))
(defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho )
(vl-load-com)
(setq blk (car (entsel "\nChon block khung ten:")))
(bigrec blk)
(setq  Rec (acet-ent-geomextents entrecblk)
	  pt1 (nth 0 Rec);lay dinh
	  pt2 (nth 1 Rec);lay dinh 
	  i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
;	(command "Line" pt1 pt2)
(KetThuc)	
(princ "\n...Done...")
(princ)
);defun

 

Và khi di chuyển cái block khung đấy ra chỗ khác thực hiện lại líp thì nó vẫn vẽ cái rectang ở chỗ cũ. E muốn nó chạy theo block cơ. Hjx

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
phamngoctukts    708
hì hì!!!

@ bác tu:

Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.

Hề hề nhưng ở cái block khung tên khác lại không có cái rectang như của bạn thì sao. Mình tưởng bạn dùng lisp này chỉ chuyên cho cái block khung tên của bạn.

BS: Mình có ý như thế này:

1. vẫn explode thằng block đó ra.

2. tạo boundary điểm pick là trọng tâm của block.

3. lấy toạ độ boundary vừa tạo

4. undo lại trạng thái ban đầu.

như vậy là code lại càng ngắn

  • 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
Tue_NV    3.841
hì hì!!!

@ bác tu:

Cách của bác hay thật. nhưng e muốn nó chạy ở bất cứ cái khung tên nào mà ko cần phải vào chỉnh trong block. Nhỡ đâu lúc có người dùng lisp này lại không biết là phải đặt cái rectang đó ở 1 layer nhất định thì nó ko chạy đc.

 

@bác Thanhbinh:

Thank bác nhiều lắm. Em đang gặm dở con của bác Tue.Nên cũng chưa kịp xem code của bác, Đợi xong con này em sẽ gặm nốt con của bác luôn, hehe

 

E đang tét thử cái này thấy nó vẽ rectang ko chuẩn, không trùng vào cái rectang đã lấy đc entname kia là sao các bác nhỉ???

(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e )
;;Tra ve entname cua rec to nhat vao bien entrecblk
(vl-load-com)
(setq plst '() Ld '() ldent '())
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
	(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE") 
    (setq s (cdr (assoc 2 (entget blk))))
    (setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
	(setq plst (append plst (list e)))
	(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
	(setq Ld '())
	(FOREACH x dsd 
	    (setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
	)
	(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
		 (>= (cdr(assoc 90 el)) 3)
		 (vlax-curve-isClosed e)
		 (null (ssget "WP" Ld))
	    )
		 (setq Ldent (append Ldent (list e)))
	)
                (setq e (entnext e))  
            )
(if (> (length Ldent) 0)
 (progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object x)) 
					   (vla-get-area (vlax-ename->vla-object y))
					)
			   )
	     ))	
   (setq entrecblk (car Ldent))
 )
)
   (command "erase" xp "")
    (command ".UNDO" "E")
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))
(defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho )
(vl-load-com)
(setq blk (car (entsel "\nChon block khung ten:")))
(bigrec blk)
(setq  Rec (acet-ent-geomextents entrecblk)
	  pt1 (nth 0 Rec);lay dinh
	  pt2 (nth 1 Rec);lay dinh 
	  i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
;	(command "Line" pt1 pt2)
(KetThuc)	
(princ "\n...Done...")
(princ)
);defun

 

Và khi di chuyển cái block khung đấy ra chỗ khác thực hiện lại líp thì nó vẫn vẽ cái rectang ở chỗ cũ. E muốn nó chạy theo block cơ. Hjx

Thực tình cũng hơi buồn vì bạn đã không đọc kĩ code của Tue_NV mà áp dụng 1 cách đúng đắn theo ý đồ của bạn.

Bạn thử cái này đã sửa lại cho bạn xem :

(defun bigrec ( blk / plst Ld dsd Ldent blk xp s p e )
;;Tra ve entname cua rec to nhat vao bien entrecblk
(vl-load-com)
(setq plst '() Ld '() ldent '())
(if (vl-cmdf "copy" blk "" '(0 0 0) "@")
	(setq xp (acet-explode (entlast)))
)
    (command ".UNDO" "BE") 
    (command "zoom" (car(acet-ent-geomextents blk)) (cadr(acet-ent-geomextents blk)))
    (setq s (cdr (assoc 2 (entget blk))))
    (setq p (cdr (assoc 10 (entget blk))))
            (setq e (cdr (assoc -2 (tblsearch "BLOCK" s))))
            (while e
                (setq el (entget e))
	(setq plst (append plst (list e)))
	(setq dsd (mapcar 'cdr (vl-remove-if '(lambda(y) (/= (car y) 10)) (entget e))))
	(setq Ld '())
	(FOREACH x dsd 
	    (setq Ld (append Ld (list (list (+ (car x) (car p)) (+ (cadr x) (cadr p)) ))))
	)
	(if (and (wcmatch (cdr(assoc 0 el)) "*POLYLINE")
		 (>= (cdr(assoc 90 el)) 3)
		 (vlax-curve-isClosed e)
		 (null (ssget "WP" Ld))
	    )
		 (setq Ldent (append Ldent (list (append (list Ld) (list e)))))
	)
                (setq e (entnext e))  
            )
(if (> (length Ldent) 0)
 (progn
(setq Ldent (vl-sort Ldent '(lambda(x y) (> (vla-get-area (vlax-ename->vla-object (cadr x))) 
					   (vla-get-area (vlax-ename->vla-object (cadr y)))
					)
			   )
	     ))	
   (setq entrecblk (car Ldent))
 )
)
   (command "erase" xp "")
   (command "zoom" "p")
    (command ".UNDO" "E")
)
(defun BatDau() (setq OldOs (getvar "osmode")) (setvar "osmode" 0))
(defun KetThuc() (setvar "osmode" OldOs))
(defun c:fd (/ Rec blk pt1 pt2 entrecblk i OldOs OldEcho )
(vl-load-com)
(setq blk (car (entsel "\nChon block khung ten:")))
(bigrec blk)
   (if entrecblk (progn
(setq  Rec (car entrecblk)
	  pt1 (nth 0 Rec);lay dinh
	  pt2 (nth 2 Rec);lay dinh 
	  i 0);setq
;-----acet-ent-geomextents:diem thap nhat trai va cao nhat phai, ve hcn
(BatDau)
(command "RECTANG" pt1 pt2)
(command "Line" pt1 pt2 "")
(KetThuc)	
(princ "\n...Done...")
)
(alert "Khong co Da giac lon nhat ma trong do khong chua doi tuong nao")
);
(princ)
);defun

@PhamngocTu : Sử dụng với mục đích như của bạn nguyentuyen6 thì explode ra cũng được. Cơ mà cái cách như trên chỉ có thể lấy thông tin thôi, chứ cập nhật và thay đổi thông tin thì không ổn. Cách hay nhất là nên thâm nhập vào kho dữ liệu của đối tượng và làm chủ 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
nguyentuyen6    127

Các bác cho em hỏi 1 câu:

 

Em có 1 tập chọn TEXT = hàm ssget

Làm sao để lấy được 1 list entname của tất cả text. mà trong List đó entname đc sắp xếp lần lượt từ cao xuống thấp dần của tập chọn text đó. (điểm để so sánh cao và thấp là dựa vào điểm chèn của text đó. VD: trong trường hợp từ cao đến thấp là dựa vào tọa độ Y còn từ trái sang phải là dựa vào tọa độ X)

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.123
Các bác cho em hỏi 1 câu:

 

Em có 1 tập chọn TEXT = hàm ssget

Làm sao để lấy được 1 list entname của tất cả text. mà trong List đó entname đc sắp xếp lần lượt từ cao xuống thấp dần của tập chọn text đó. (điểm để so sánh cao và thấp là dựa vào điểm chèn của text đó. VD: trong trường hợp từ cao đến thấp là dựa vào tọa độ Y còn từ trái sang phải là dựa vào tọa độ X)

Chào bạn nguyentuyen6,

Dùng lisp hoàn toàn có thể làm được điều bạn yêu cầu.

1/- lấy tập hợp chọn bằng hàm ss như bạn đã làm.

2/- Duyệt qua các đối tượng để tạo một danh sách các phần tử kép gồm điểm đặt và ename của mỗi đối tượng

3/- Cùng hàm (vl-sort ....) để sắp xếp lại danh sách trên theo trật tự mà bạn muốn (tham khảo thêm hàm lambda)

4/- Tạo dach sách mới chỉ có các ename theo trật tự đã phân loại.

 

Bạn hãy thử làm xem nhé. Khó đâu hỏi tiếp nhé...

  • 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
nguyentuyen6    127

E đã thử theo bác và viết ra đc cái sắp xếp đc entname theo trục Y từ cao xuống thấp. Nhưng sao kết quả trả về lại bị in ra 2 lần vậy bác nhỉ.

 

(defun c:tt(/ i ltn name_textnguon diemdat dxf_tn)
(setq ltn '()
i 0)
(setq textnguon (ssget))
(while (< i (sslength textnguon)) 
	(setq name_textnguon (ssname textnguon i) ; lay entname
		  dxf_tn (entget name_textnguon);lay dxf
		  diemdat (cadr (cdr (assoc 10 dxf_tn))); lay diem dat text
		  lst_entname_diemdat (list diemdat name_textnguon); tao list 
	)
	(setq ltn (append ltn (list lst_entname_diemdat)))
	(setq i (1+ i))
);while
;;;;;-------
(vl-sort ltn
            (function (lambda (e1 e2)
                        (< (car e1) (car e2)) ) ) 
)
(princ ltn)	
)

 

Em thấy cái hàm vl-sort nó ghi là bỏ những kq trùng nhau mà.

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.123
E đã thử theo bác và viết ra đc cái sắp xếp đc entname theo trục Y từ cao xuống thấp. Nhưng sao kết quả trả về lại bị in ra 2 lần vậy bác nhỉ.

 

(defun c:tt(/ i ltn name_textnguon diemdat dxf_tn)
(setq ltn '()
i 0)
(setq textnguon (ssget))
(while (		(setq name_textnguon (ssname textnguon i) ; lay entname
		  dxf_tn (entget name_textnguon);lay dxf
		  diemdat (cadr (cdr (assoc 10 dxf_tn))); lay diem dat text
		  lst_entname_diemdat (list diemdat name_textnguon); tao list 
	)
	(setq ltn (append ltn (list lst_entname_diemdat)))
	(setq i (1+ i))
);while
;;;;;-------
(vl-sort ltn
            (function (lambda (e1 e2)
                        ()
(princ ltn)	
)

 

Em thấy cái hàm vl-sort nó ghi là bỏ những kq trùng nhau mà.

Hề hề hề,

Chào bạn nguyentuyen6,

Nó in chỉ có một lần , còn lần thứ hai là do khi bạn thoát khỏi chương trình lisp Cad tự in ra giá trị cuối cùng của lisp. Cái này là do Cad nó mặc định như vậy. Để tránh trường hợp này, bạn cho thêm hàm princ vào cuối chương trình.

Nó bỏ các giá trị trùng nhau là vì bạn sử dụng hàm so sánh nhỏ hơn. Nếu bạn dùng hàm so sánh là nhỏ hơn và bằng thì nó không loại các giá trị trùng nhau.

  • 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
nguyentuyen6    127

Hì. E xin đính chính lại là sắp theo trục y từ thấp đến cao. Nhưng lại có 1 vấn đề ở hàm lambda.

 

Ở trên là em dùng nó với 2 đối số. với chọn 2 text thì cho kq đúng. nhưng chọn nhiều hơn sẽ ra sai. Như trên là hàm lambda nó xét theo từng cặp phải ko ạ. và cách giải quyết để cái list dùng hàm vl-sort sẽ cho ra kết quả sắp xếp từ thấp đến cao????( với list nhiều hơn 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
Tue_NV    3.841
Hì. E xin đính chính lại là sắp theo trục y từ thấp đến cao. Nhưng lại có 1 vấn đề ở hàm lambda.

 

Ở trên là em dùng nó với 2 đối số. với chọn 2 text thì cho kq đúng. nhưng chọn nhiều hơn sẽ ra sai. Như trên là hàm lambda nó xét theo từng cặp phải ko ạ. và cách giải quyết để cái list dùng hàm vl-sort sẽ cho ra kết quả sắp xếp từ thấp đến cao????( với list nhiều hơn 2)

Đổ oan cho hàm lambda tội lắm.

Lý do :

Thay dòng :

(vl-sort ltn

(function (lambda (e1 e2)

(

)

Thanh dòng :

(setq ltn (vl-sort ltn

(function (lambda (e1 e2)

(

)

)

  • 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
nguyentuyen6    127
Đổ oan cho hàm lambda tội lắm.

Lý do :

Thay dòng :

(vl-sort ltn

(function (lambda (e1 e2)

(< (car e1) (car e2)) ) )

)

Thanh dòng :

(setq ltn (vl-sort ltn

(function (lambda (e1 e2)

(< (car e1) (car e2)) ) )

)

)

 

Hixx. Cảm ơn 2 bác nhiều lắm!!!!

 

Em quên mất chưa setq cho nó, hì hì. nên lúc princ ra nó in lại cái hàm lúc chưa sắp xế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
pfievxd    6

Em đang tập tành sử dụng hàm ssget, hôm qua viết 1 hàm thế này

(Defun c:Class()

(Setq ss (ssget "W")

n (sslength ss)

id 0

Ds1 '())

(Repeat n

(Setq el (ssname ss id)

Info (entget el))

(if

(= (cdr(assoc 2 Info)) "ANSI31")

(Setq Ds1(Append (list el) Ds1)))

(Setq id(1+ id))

)

(Princ))

Mục đích của nó là quét 1 lần được các đối tượng, sau đó mới lọc riêng đưa vào các list khác nhau; ở đây em mới check thử cho 1 list ds1 nhưng mà bị lỗi bad argument point? Có bác nào bít lỗ này do đâu ko ah

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.841
Em đang tập tành sử dụng hàm ssget, hôm qua viết 1 hàm thế này

(Defun c:Class()

(Setq ss (ssget "W")

n (sslength ss)

id 0

Ds1 '())

(Repeat n

(Setq el (ssname ss id)

Info (entget el))

(if

(= (cdr(assoc 2 Info)) "ANSI31")

(Setq Ds1(Append (list el) Ds1)))

(Setq id(1+ id))

)

(Princ))

Mục đích của nó là quét 1 lần được các đối tượng, sau đó mới lọc riêng đưa vào các list khác nhau; ở đây em mới check thử cho 1 list ds1 nhưng mà bị lỗi bad argument point? Có bác nào bít lỗ này do đâu ko ah

Bạn bị lỗi ở hàm ssget

(ssget "W")

phải được viết như thế này :

(ssget "W" p1 p2)

P1 và p2 là 2 điểm tạo nên cửa sổ "W"

 

Bạn xem lại cú pháp của hàm ssget nhé

  • 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
khaosat2009    10

-Mình có một Lisp về chuyển các đường nét, mình muốn nhờ các anh hướng dẫn cho việc chuyển nét với kiểu đường nét mới theo file ***. lin khác thì làm thế nào trên lisp này. Mong được các anh giúp

M;============================================================================ok

 

(DEFUN C:CN ( / Sset Elist Msg OldLineType NewLineType)

(princ " \Chon doi tuong can chuyen sang kieu net khac : ")

(setq Sset (ssget))

(progn

(setq OldLineType (getvar "CELTYPE"))

(setq Msg (strcat "\nNewLineType ? \nLien/Khuat/Truc/Gach/Vien/Ao/Cham/CCham/CGach: <" OldLineType "> : "))

(Initget "Lien Khuat Truc Gach Vien Ao Cham CCham CGach")

(setq NewLineType (getkword Msg))

(if (= NewLineType Nil) (setq NewLineType OldLineType))

(If (= NewLineType "Lien") (setq NewLineType "Continuous"))

(If (= NewLineType "Khuat") (setq NewLineType "Hidden"))

(If (= NewLineType "Truc") (setq NewLineType "Center"))

(If (= NewLineType "Gach") (setq NewLineType "Dashed"))

(If (= NewLineType "Vien") (setq NewLineType "Border"))

(If (= NewLineType "Ao") (setq NewLineType "Phantom"))

(If (= NewLineType "Cham") (setq NewLineType "Divide"))

(If (= NewLineType "CCham") (setq NewLineType "Dot"))

(If (= NewLineType "CGach") (setq NewLineType "Dashdot"))

(command "CHPROP" Sset "" "LT" NewLineType "")

) ;end progn

(princ)

) ;end

;============================================================================

 

File kí hiệu nét kèm theo : http://www.cadviet.com/upfiles/3/acadtam.rar

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
pfievxd    6

Cái này băn khoăn lâu rồi, nhưng thấy nó chưa ảnh hưởng nghiệm trọng lắm nên hôm nay mới hỏi mọi người :

Mình có chương trình con thế này :

 

(Defun TinhDT(ds)

(Foreach pt ds

(Command "AREA" "O" pt)

(Setq DT(Getvar"AREA")

TDT(+ TDT DT))

)

(Princ(Strcat"\n Total Area =" (Rtos TDT 2 2) " m2"))

(Princ))

;-----------------------------------------------------

Để không ghép vào chương trình chính thì chạy ngon, nhưng muốn khai báo cho rõ ràng biến cục bộ để dễ kiểm soát thì gặp lỗi Too Few argument :

Mình sửa thế này đây (Defun TinhDT(ds / pt DT)....Các cao thủ chỉ giáo giúp mình với !

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
Thaistreetz    515
Cái này băn khoăn lâu rồi, nhưng thấy nó chưa ảnh hưởng nghiệm trọng lắm nên hôm nay mới hỏi mọi người :

Mình có chương trình con thế này :

 

(Defun TinhDT(ds)

(Foreach pt ds

(Command "AREA" "O" pt)

(Setq DT(Getvar"AREA")

TDT(+ TDT DT))

)

(Princ(Strcat"\n Total Area =" (Rtos TDT 2 2) " m2"))

(Princ))

;-----------------------------------------------------

Để không ghép vào chương trình chính thì chạy ngon, nhưng muốn khai báo cho rõ ràng biến cục bộ để dễ kiểm soát thì gặp lỗi Too Few argument :

Mình sửa thế này đây (Defun TinhDT(ds / pt DT)....Các cao thủ chỉ giáo giúp mình với !

trong đoạn code trên của bạn thì pt không thể định nghĩa là biến cục bộ đc. nó có thể gọi là 1 "biến tạm", đuợc hàm foreach tạo ra trong mỗi vòng lặp. biến này đuợc giải phóng ngay khi foreach kết thúc.

với hàm trên thì có thể định nghĩa các biến DT và TDT là biến cục bộ.

PS: bạn viết thừa 1 biến DT không cần thiết, nên viết thế này : (setq TDT (+ TDT (getvar "area")))

  • 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
Tue_NV    3.841
-Mình có một Lisp về chuyển các đường nét, mình muốn nhờ các anh hướng dẫn cho việc chuyển nét với kiểu đường nét mới theo file ***. lin khác thì làm thế nào trên lisp này. Mong được các anh giúp

M;============================================================================ok

 

 

 

(DEFUN C:CN ( / Sset Elist Msg OldLineType NewLineType)

(princ " \Chon doi tuong can chuyen sang kieu net khac : ")

(setq Sset (ssget))

(progn

(setq OldLineType (getvar "CELTYPE"))

(setq Msg (strcat "\nNewLineType ? \nLien/Khuat/Truc/Gach/Vien/Ao/Cham/CCham/CGach: : "))

(Initget "Lien Khuat Truc Gach Vien Ao Cham CCham CGach")

(setq NewLineType (getkword Msg))

(if (= NewLineType Nil) (setq NewLineType OldLineType))

(If (= NewLineType "Lien") (setq NewLineType "Continuous"))

(If (= NewLineType "Khuat") (setq NewLineType "Hidden"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(command "CHPROP" Sset "" "LT" NewLineType "")

) ;end progn

(princ)

) ;end

;============================================================================

 

File kí hiệu nét kèm theo : http://www.cadviet.com/upfiles/3/acadtam.rar

Trước hết, bạn phải Load đường nét vào trong CAD

Nếu file ACADTAM.LIN của bạn nằm trong SUpport file search Path thì bạn có thể Load như thế này :

Ví dụ tên đường nét "BOSONG52" nằm trong ACADTAM.LIN của bạn được Load bằng mã lệnh như sau :

(if (not (tblsearch "LTYPE" "BOSONG52"))

(command "linetype" "L" "BOSONG52" "ACADTAM.LIN" "")

)

 

Nếu file ACADTAM.LIN của bạn không nằm trong SUpport file search Path . Nằm ổ C:\ chẳng hạn. Code như sau :

(if (not (tblsearch "LTYPE" "BOSONG52"))

(command "linetype" "L" "BOSONG52" "C:\\ACADTAM.LIN" "")

)

 

-> Sau đó là áp dụng các code chuyển nét của bạn

Góp ý : Nên tạo 1 hàm con để sử dụng cho việc Load đường nét và chuyển đổi đường nét

Hy vọng bạn làm được

Chúc thành công :iluvyousmiley:

  • 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
khaosat2009    10
Trước hết, bạn phải Load đường nét vào trong CAD

Nếu file ACADTAM.LIN của bạn nằm trong SUpport file search Path thì bạn có thể Load như thế này :

Ví dụ tên đường nét "BOSONG52" nằm trong ACADTAM.LIN của bạn được Load bằng mã lệnh như sau :

(if (not (tblsearch "LTYPE" "BOSONG52"))

(command "linetype" "L" "BOSONG52" "ACADTAM.LIN" "")

)

 

Nếu file ACADTAM.LIN của bạn không nằm trong SUpport file search Path . Nằm ổ C:\ chẳng hạn. Code như sau :

(if (not (tblsearch "LTYPE" "BOSONG52"))

(command "linetype" "L" "BOSONG52" "C:\\ACADTAM.LIN" "")

)

 

-> Sau đó là áp dụng các code chuyển nét của bạn

Góp ý : Nên tạo 1 hàm con để sử dụng cho việc Load đường nét và chuyển đổi đường nét

Hy vọng bạn làm được

Chúc thành công :iluvyousmiley:

Mình gà mờ về lisp, mong được bạn chỉ cho các hàm con để dùng load các file *.lin chọn nhanh các đường nét khi vẽ.

Cám ơ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
Tue_NV    3.841
Mình gà mờ về lisp, mong được bạn chỉ cho các hàm con để dùng load các file *.lin chọn nhanh các đường nét khi vẽ.

Cám ơn

Hàm con Load_Change sẽ load Linetype trong ACADTAM.LIN và đổi Linetype cho đối tượng chọn bởi ssget

ACADTAM.LIN nằm trong Support file search Path của CAD

Nếu không nằm trong Support file search Path của CAD thì phải khai đầy đủ đường dẫn cho nó khi hàm findfile trả về nil, tức là không tìm thấy ACADTAM.LIN trong Support file search Path

 

Mình viết cho Linetype BOSONG52, Các đường nét khác, bạn cứ theo đó mà viết tiếp

(DEFUN C:CN ( / Sset Elist Msg OldLineType NewLineType)
(princ " \Chon doi tuong can chuyen sang kieu net khac : ")
(if (setq Sset (ssget))
(progn
(setq OldLineType (getvar "CELTYPE"))
(setq Msg (strcat "\nBosong:  : "))
(Initget "Lien Khuat Truc Gach Vien Ao Cham CCham CGach Bosong")
(setq NewLineType (getkword Msg))
(if (= NewLineType Nil) (setq NewLineType OldLineType))
(If (= NewLineType "Bosong") (Load_Change "BOSONG52" sset))
       ;;;;;viet tiep vao cho nay nhe
)) ;end progn
(princ)
) ;end 
;;
(defun Load_Change(duongnet ss)
 (if (findfile "ACADTAM.LIN")
   (progn
    (if (not (tblsearch "LTYPE" duongnet))
         (command "linetype" "L" duongnet "ACADTAM.LIN" "")
    ) 
(command "CHPROP" ss "" "LT" duongnet "")
   )
 )
)

  • 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
pfievxd    6

@ThaiStreetz: Bác nhiệt tình thật đấy, cái dòng PS của bác đúng là rất hợp ý em, em đang trong giai đoạn tinh chỉnh những Lisp đã viết mà ^^

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
gia_bach    1.442
Mọi người cho e hỏi code của hàm ARAY trong lisp với nhé.

Tham khảo Lisp :

Array đối tượng trong vùng ... của Tue_NV.

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
khaosat2009    10
Hàm con Load_Change sẽ load Linetype trong ACADTAM.LIN và đổi Linetype cho đối tượng chọn bởi ssget

ACADTAM.LIN nằm trong Support file search Path của CAD

Nếu không nằm trong Support file search Path của CAD thì phải khai đầy đủ đường dẫn cho nó khi hàm findfile trả về nil, tức là không tìm thấy ACADTAM.LIN trong Support file search Path

 

Mình viết cho Linetype BOSONG52, Các đường nét khác, bạn cứ theo đó mà viết tiếp

(DEFUN C:CN ( / Sset Elist Msg OldLineType NewLineType)
(princ " \Chon doi tuong can chuyen sang kieu net khac : ")
(if (setq Sset (ssget))
(progn
(setq OldLineType (getvar "CELTYPE"))
(setq Msg (strcat "\nBosong: <" OldLineType "> : "))
(Initget "Lien Khuat Truc Gach Vien Ao Cham CCham CGach Bosong")
(setq NewLineType (getkword Msg))
(if (= NewLineType Nil) (setq NewLineType OldLineType))
(If (= NewLineType "Bosong") (Load_Change "BOSONG52" sset))
       ;;;;;viet tiep vao cho nay nhe
)) ;end progn
(princ)
) ;end 
;;
(defun Load_Change(duongnet ss)
 (if (findfile "ACADTAM.LIN")
   (progn
    (if (not (tblsearch "LTYPE" duongnet))
         (command "linetype" "L" duongnet "ACADTAM.LIN" "")
    ) 
(command "CHPROP" ss "" "LT" duongnet "")
   )
 )
)

Lisp không thực hiện được bạn ơi, mong ban giú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
Tue_NV    3.841
Lisp không thực hiện được bạn ơi, mong ban giúp

File ACADTAM.LIN của bạn phải nằm trong Support file Search Path

 

Command: cn

Chon doi tuong can chuyen sang kieu net khac :

Select objects: Specify opposite corner: 1 found

 

Select objects:

Bosong: : bosong

...

....

Hy vọng bạn làm được

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


×