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

giúp em làm cái lisp vẽ đoạn thẳng này với.

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

  Vì công việc cứ lập đi lập lại nhiều lần, mà mình chưa biết viết lisp như thế nào. Nay em nhờ mọi người viết giúp em một lisp như sau.

có 2 tùy chọn:

**loại 1

- Có hai đoạn thẳng song song với nhau và có chiều dài bằng nhau ( x và y là hai biến số bất kì).

- Vẽ một đường thẳng nối trung điểm của hai đường song song đó( và đường này có layer tên là "100"). 

- Đường này được vẽ khi ta quét chọn hai đường song song kia.85004_20140425_004104.png

 

**loại 2 :

- vẽ hình chữ nhật qua bốn điểm của hai đường song song kia( lúc này hai đường song song sẽ là hai cạnh của hình chữ nhật đó).

Mọi người ai ghé qua giúp em với. Thank tất cả mọi ngườ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

Hình minh hoạ thì k có 2 Line xiên, nên mình quick code như thế này cho bạn, dùng tạm nhé

 

;Free from Cadviet @Cadmagic
(defun *get*(/ s a b lst dxf)
	(defun dxf(e id)(cdr (assoc id (entget e))))
	(and (setq s (ssget '((0 . "LINE"))))
		(> (sslength s) 1)	
		(setq a (ssname s 0) b (ssname s (1- (sslength s))) lst (mapcar 'dxf (list a a b b)'(10 11 10 11)))
	) lst
)
(defun c:loai1(/ mid l)
	(defun mid(a b)(mapcar '* (mapcar '+ a b) '(0.5 0.5 0.5)))
	(and (setq l(*get*)) 
		(command ".Line" "_non" (mid (car l)(cadr l)) "_non" (mid (caddr l)(last l)) "" "_.Chprop" "_Last" "" "_LAyer" "100" ""))
	(princ)
)
(defun c:loai2(/ l)
	(and 
		(setq l(*get*))
		(setq l (apply 'mapcar (cons 'list l)))
		(command "_.Rectangle" "_non" 
			(mapcar '(lambda(x)(apply 'min x)) l)
			"_non"
			(mapcar '(lambda(x)(apply 'max x)) l)
		)
	) (princ)
)
  • Vote tăng 3

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

 

Hình minh hoạ thì k có 2 Line xiên, nên mình quick code như thế này cho bạn, dùng tạm nhé

 

;Free from Cadviet @Cadmagic
(defun *get*(/ s a b lst dxf)
	(defun dxf(e id)(cdr (assoc id (entget e))))
	(and (setq s (ssget '((0 . "LINE"))))
		(> (sslength s) 1)	
		(setq a (ssname s 0) b (ssname s (1- (sslength s))) lst (mapcar 'dxf (list a a b b)'(10 11 10 11)))
	) lst
)
(defun c:loai1(/ mid l)
	(defun mid(a b)(mapcar '* (mapcar '+ a b) '(0.5 0.5 0.5)))
	(and (setq l(*get*)) 
		(command ".Line" "_non" (mid (car l)(cadr l)) "_non" (mid (caddr l)(last l)) "" "_.Chprop" "_Last" "" "_LAyer" "100" ""))
	(princ)
)
(defun c:loai2(/ l)
	(and 
		(setq l(*get*))
		(setq l (apply 'mapcar (cons 'list l)))
		(command "_.Rectangle" "_non" 
			(mapcar '(lambda(x)(apply 'min x)) l)
			"_non"
			(mapcar '(lambda(x)(apply 'max x)) l)
		)
	) (princ)
)
Thank ketxu, lisp bạn làm giúp mình rất tốt. Cảm ơn bạn 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

 Em trót dại nhấn Like nên đành phải spam một phát cho đỡ thiệt thòi! :) :) :)

Nếu bác Ketxu làm cái loai1 và loai2, chơi kiểu chém đồng loạt nhiều em cùng một nhát, đính kèm điều kiện loai2 chơi được em không vuông góc với OX hoặc OY sẽ đỡ... bức xúc hơn.

Và đặc biệt, nếu loai1 và loai2 của bác mà không chê em Mline, thì chẳng còn gì sờ pam nữa!

  • 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

 Em trót dại nhấn Like nên đành phải spam một phát cho đỡ thiệt thòi! :) :) :)

Nếu bác Ketxu làm cái loai1 và loai2, chơi kiểu chém đồng loạt nhiều em cùng một nhát, đính kèm điều kiện loai2 chơi được em không vuông góc với OX hoặc OY sẽ đỡ... bức xúc hơn.

Và đặc biệt, nếu loai1 và loai2 của bác mà không chê em Mline, thì chẳng còn gì sờ pam nữa!

được như thế thì còn gì bằng bác nhể  :ph34r:

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ứ cho mình file mô tả cụ thể là có kết quả ngay :D

 

P/s : cái này ngoài lề thôi, nhưng thấy khá thú vị. Dạo này mấy bài mình viết gần đây đều được yêu quý tặng like, nhưng chắc có bạn không ưa nên lại vào đâu đó tặng dấu -, thành ra cứ ngày một ít đi.  Hài quá. Tiếc là 4room k cho mem biết ai thank, ai dislike hoặc chí ít là bài bị dislike để biết mình hay - dở ở bài nào mà còn vào thanh minh / rút kn ^^

 

P/s 2 : đã tìm thấy chỗ bài bị dislike. Ngay trong các mục mình post giáo trình CAD cơ bản. Chắc các bạn vào k đọc được nên ghét ^^

  • 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

Mô tả tính năng: vẽ line phụ ngăn cách phòng để hỗ trợ bao phòng bằng lệnh BO

Lisp gồm có một tính năng duy nhất đó là vẽ đường màu vàng có layer là : 002-Leichtbau

 

 

 

Ở hình trên là hai type:

Khi gõ lênh t1 : thì đường màu vàng vẽ qua trung điểm của hai đường song song, sau khi quét chọn hai đường đó

Khi gõ lệnh t2 : thì đường màu vàng được vẽ nối hai điểm ngoài cùng ( như hình), sau khi quét chọn hai đường đó.

Nếu có thể thì chọn nhiều cặp đường như thế một lúc.

Vì bề rộng cữa có tiêu chuẩn nên thường chỉ có cữa rộng dưới 1,2 m.Em vừa làm file mô tả bằng w10 bác xem giúp chót cho em bác nhen  :angry2:

85004_20140425_210601.png

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

Trời! Vậy mà lại tưởng anh recycle90 làm cái ...gì

Cơ mà sao dòm cái cửa của anh chẳng giống ai thế nhỉ, sao anh không dùng block cửa cho hoành tráng: http://www.cadviet.com/forum/topic/21441-share-block-cua-da-dang/

Dùng lisp có một cái khổ là lại phải mất công nhớ tên lisp...làm sao sướng bằng việc nhớ cái khá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

Trời! Vậy mà lại tưởng anh recycle90 làm cái ...gì

Cơ mà sao dòm cái cửa của anh chẳng giống ai thế nhỉ, sao anh không dùng block cửa cho hoành tráng: http://www.cadviet.com/forum/topic/21441-share-block-cua-da-dang/

Dùng lisp có một cái khổ là lại phải mất công nhớ tên lisp...làm sao sướng bằng việc nhớ cái khác :) :) :)

sản phẩm của mình đây 85004_6129600257_100.gif85004_grundriss.jpg

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ứ cho mình file mô tả cụ thể là có kết quả ngay :D

 

P/s : cái này ngoài lề thôi, nhưng thấy khá thú vị. Dạo này mấy bài mình viết gần đây đều được yêu quý tặng like, nhưng chắc có bạn không ưa nên lại vào đâu đó tặng dấu -, thành ra cứ ngày một ít đi.  Hài quá. Tiếc là 4room k cho mem biết ai thank, ai dislike hoặc chí ít là bài bị dislike để biết mình hay - dở ở bài nào mà còn vào thanh minh / rút kn ^^

 

P/s 2 : đã tìm thấy chỗ bài bị dislike. Ngay trong các mục mình post giáo trình CAD cơ bản. Chắc các bạn vào k đọc được nên ghét ^^

 

Thân mến tặng bác Ketxu tiết mục thư giãn:

http://www.youtube.com/watch?v=p9VYjiQx4ns

  • 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

Bác Ketxu chắc bận rồi, thôi dùng tạm cái này, lệnh t1, t2.


(defun dxf (id v)  (cdr (assoc id (entget v))))
  
(defun c:t1(/ os kotieptuc ss)
  (defun kieu1(l) (entmakex (list '(0 . "LINE") (cons 10 (car l)) (cons 11 (last l)) (cons 8 "002-Leichtbau"))))
  (defun midp(d1 d2) (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
  
  (setq os (getvar 'osmode) kotieptuc nil)
  (setvar 'osmode 0)
  
  (while (not kotieptuc)
    (princ "\nChon 2 doan thang song song:")
    (setq ss (ssget '((0 . "LINE"))))
    (if (not ss)
      (setq kotieptuc t)
      (progn
 (setq kotieptuc nil)
    (kieu1 (mapcar '(lambda(x) (midp (dxf 10 x) (dxf 11 x))) (acet-ss-to-list ss))))
  ))
  (setvar 'osmode os) (princ)
)
  
(defun c:t2(/ os kotieptuc ss)
  (defun kieu2(l)    
     (entmakex (list '(0 . "LINE") (cons 10 (caar l)) (cons 11 (caadr l)) (cons 8 "002-Leichtbau")))
     (entmakex (list '(0 . "LINE") (cons 10 (cadar l)) (cons 11 (cadadr l)) (cons 8 "002-Leichtbau"))))
  
  (defun parallel(l)
    (if (equal (angle (caar l) (caadr l)) (angle (cadar l) (cadadr l)) 0.001)
      l (parallel (list (car l) (reverse (cadr l)))))
  )
  
  (setq os (getvar 'osmode) kotieptuc nil)
  (setvar 'osmode 0)
  
  (while (not kotieptuc)
    (princ "\nChon 2 doan thang song song:")
    (setq ss (ssget '((0 . "LINE"))))
    (if (not ss)
      (setq kotieptuc t)
      (progn
 (setq kotieptuc nil)
    (kieu2 (parallel (mapcar '(lambda(x) (list (dxf 10 x) (dxf 11 x))) (acet-ss-to-list ss)))))
  ))
  (setvar 'osmode os) (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

@Hoằn : cảm ơn e vì món quà ^^  

@OP : cái này chắc chỉ ứng dụng cho mỗi bạn hén. Ket quick lại lần nữa đây, lần này lười lấy luôn mấy hàm Acet. Cứ chọn được 2 thằng thì bạn lại Cách 1 phát nhé - Chọn mãi.    

 

(defun *get*(/ s a b l dxf)	
	(and (setq s (ssget '((0 . "LINE"))))		
		(setq l (mapcar '(lambda(x)(list (acet-dxf 10 x)(acet-dxf 11 x)))(mapcar 'entget (acet-ss-to-list s))))
	) 
	l
)
(defun eL(a b)(entmake (list (cons 0 "LINE")(cons 10 a)(cons 11 b)(cons 8 "002-Leichtbau"))))
(defun c:t1(/ mid l)	
	(while (setq l(*get*)) (eL (apply 'acet-geom-midpoint  (car l)) (apply 'acet-geom-midpoint  (last l))))	
)
(defun c:t2(/ l rs)
	(defun rs(l)(cond ((<= (apply 'angle l) pi) l)((reverse l))))
	(while (setq l(*get*))(mapcar '(lambda(x y)(eL x y))  (car (setq l (mapcar 'rs l))) (last l)))		
)

 

@Tot77 : bạn đã entmake rồi thì đặt osnap chi ta ^^ Với lại k có nhu cầu bắt lại đối tượng thì dùng entmakex có phí quá k ? Thanked defun parallel :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

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


×