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

[recycle90 0]

  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.

 

**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.

[recycle90 0]

:mellow:  :)

[ketxu 2.984]

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)
)

[recycle90 0]

 

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.

[Hoan1111 695]

 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!

[recycle90 0]

 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:

[ketxu 2.984]

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 ^^

[recycle90 0]

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:

[Hoan1111 695]

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 :) :) :)

[recycle90 0]

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 

[Hoan1111 695]

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

[recycle90 0]

bác ketxu đâu rồi bác wởi

[Tot77 508]

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)

)

 

[recycle90 0]

Thank  Tot77, chắc bác ở bđ nhề, để e test xem  :mellow:

:)

[Tot77 508]

bd là ở đâu sao tôi không biết vậy cà?

[ketxu 2.984]

@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

[recycle90 0]

Thank mấy bác nha :D