Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
16 replies to this topic

#1 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 April 2014 - 12:48 AM

  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.


  • 0

#2 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 April 2014 - 11:12 AM

:mellow:  :)


  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 25 April 2014 - 12:55 PM

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

  • 3

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 April 2014 - 01:54 PM

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.

  • 0

#5 Hoan1111

Hoan1111

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2587 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 25 April 2014 - 02:34 PM

 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!


  • 1

66 Câu Phật Học Cho Cuộc Sống : http://ngocchinh.com...-cho-cuoc-song/

Gió đưa cây cải về trời / Rau răm ở lại chịu lời đắng cay...

 

 


#6 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 April 2014 - 07:38 PM

 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:


  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 25 April 2014 - 08:45 PM

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


  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#8 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 April 2014 - 09:06 PM

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


  • 0

#9 Hoan1111

Hoan1111

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2587 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 26 April 2014 - 08:35 AM

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.c...ck-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 :) :) :)


  • 0

66 Câu Phật Học Cho Cuộc Sống : http://ngocchinh.com...-cho-cuoc-song/

Gió đưa cây cải về trời / Rau răm ở lại chịu lời đắng cay...

 

 


#10 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 April 2014 - 10:23 AM

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.c...ck-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


  • 0

#11 Hoan1111

Hoan1111

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 2587 Bài viết
Điểm đánh giá: 692 (tốt)

Đã gửi 26 April 2014 - 03:15 PM

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:


  • 1

66 Câu Phật Học Cho Cuộc Sống : http://ngocchinh.com...-cho-cuoc-song/

Gió đưa cây cải về trời / Rau răm ở lại chịu lời đắng cay...

 

 


#12 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 April 2014 - 06:22 PM

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


  • 0

#13 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 26 April 2014 - 08:38 PM

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


  • 1

#14 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 April 2014 - 11:21 PM

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

:)


  • 0

#15 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 27 April 2014 - 12:07 AM

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

#16 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 April 2014 - 11:53 AM

@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


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#17 recycle90

recycle90

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 April 2014 - 12:53 PM

Thank mấy bác nha :D


  • 0