Nhờ viết lisp tạo hình chữ nhật song song và vuông góc với đường thẳng và hình bất kì.

[zutum 0]

Hi các bạn,

Mình muốn nhờ các bạn viết dùm mình 1 lisp khi ta pick vào 1 cạnh của hình bất kì ( vuông, chữ nhật , tam giác...) hoặc 1 đoạn thằng bất kì. vd: đường màu vàng của hình 1.

Sau đó bấm 5 ( hoặc số bất kì ) để có khoảng cách thứ 1,

bấm 15 ( hoặc số bất kì ) để có khoảng cách thứ 2,

Bấm 20 ( hoặc số bất kì ) để đc chiều cao thứ 3

ta được 1 hình chữ nhật như hình 2 và kích thước như hình 3.

Xin cảm ơn các bạn rất nhiều.

 

 

 

[cuongtk2 342]

Đây em

(defun c:hcncheo( / ANG ANG1 DIST E ENT ENTS H L1 L2 LISTDINH NAME OBJ P1 P2 P3 P4 P5 P6 PARAM PE PS PT)
(setq ents (entsel "\nPick entity"))
(if (null ents) (exit))
(setq pt (cadr ents)
      ent (car ents)
      name (acet-dxf 0 (entget ent)))
(if (null (or (= name "LWPOLYLINE")
	(= name "LINE"))
	  )
  (exit)
  )
(if (= name "LWPOLYLINE")
(setq obj (vlax-ename->vla-object ent)
      pt (vlax-curve-getclosestpointto obj pt)
      param (fix (vlax-curve-getParamAtPoint obj pt))
      ps (vlax-curve-getPointAtParam obj param)
      pe (vlax-curve-getPointAtParam obj (+ param 1))
      )
  )
(if (= name "LINE")
  (setq ps (acet-dxf 10 (entget ent))
	pe (acet-dxf 11 (entget ent))
	)
  )

(setq p1 (if (< (car ps) (car pe)) ps pe)
      p2 (if (< (car ps) (car pe)) pe ps)
      ang (angle p1 p2)
      ang1 (+ ang (* pi 0.5))
      dist (DISTANCE p1 p2))
(alert (strcat "L= "  (rtos dist 2 2)))
(setq l1 (getdist "\nL1:"))
(setq l2 (getdist "\nL2:"))
(if (> (+ l1 l2) dist)
  (alert "Tong L1 + L2  qua lon")
  )
(setq h (getdist "\nH:"))

(setq p3 (polar p1 ang l1)
      p4 (polar p2 ang (- 0 l2))
      p5 (polar p4 ang1 h)
      p6 (polar p3 ang1 h)
      )

(DEFUN make_lwpolyline  (list_dinh dong_lai do_day layer / dlist elist1 e_list n i)
  (SETQ n (LENGTH list_dinh))
  (SETQ dlist nil)
  (SETQ i 0)
  (WHILE (< i n)
    (SETQ dlist (APPEND dlist
                        (list_point_pline (NTH i list_dinh) do_day)
                        )
          )
    (SETQ i (1+ i))
    )

  (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE")
                     (CONS 100 "AcDbEntity")
                     (CONS 410 "Model")
                     (CONS 8 layer)
                     (CONS 100 "AcDbPolyline")
                     (CONS 90 n)
                     (CONS 70 dong_lai)
 ;(cons 43 0.0)
                     (CONS 38 0.0)
                     (CONS 39 0.0)))
  (SETQ e_list nil)
  (SETQ e_list (APPEND elist1 dlist))
  (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0))))
  (ENTMAKE e_list)
  )

(DEFUN make_dim_y1  (style p1 p2 p3  ang layer / d e_list basepoint p4)
  
  (SETQ e_list (LIST
                 (CONS 0 "DIMENSION")
                 (CONS 100 "AcDbEntity")
                 (CONS 67 0)
                 (CONS 410 "Model")
                 (CONS 8 layer)
                 (CONS 100 "AcDbDimension")
                 (cons 10 p3)
                 (cons 11 p3)
                 (LIST 12 0.0 0.0 0.0)
                 (CONS 70 32)
                 (CONS 1 "")
                 (CONS 71 5)
                 (CONS 72 1)
                 (CONS 41 1.0)
                 (CONS 42 0)
                 (CONS 52 0.0)
                 (CONS 53 0.0)
                 (CONS 54 0.0)
                 (CONS 51 0.0)
                 (LIST 210 0.0 0.0 1.0)
                 (CONS 3 style)
                 (CONS 100 "AcDbAlignedDimension")
                 (cons 13 p1)
                 (cons 14 p2)
                 (LIST 15 0.0 0.0 0.0)
                 (LIST 16 0.0 0.0 0.0)
                 (CONS 40 0.0)
                 (CONS 50 ang)
                 (CONS 100 "AcDbRotatedDimension")
		 )
        )
  (ENTMAKE e_list)


  )

(setq listdinh (mapcar '(lambda (e) (list (car e) (cadr e))
			  )
		       (list p3 p4 p5 p6))
      )
(MAKE_LWPOLYLINE listdinh 1 0 "chunhat")

(MAKE_DIM_Y1 "Standard" p3 p6 (polar p1 (- 0 ang) (+ h h)) ang1 "dim")
(MAKE_DIM_Y1 "Standard" p1 p3 (polar p1 ang1 (+ h h)) ang  "dim")
(MAKE_DIM_Y1 "Standard" p4 p2 (polar p1 ang1 (+ h h)) ang  "dim")


)

 

[zutum 0]

thanks anh nhiều. em đang dùng cad 2018 mà hình như nó không chạy được anh.

[cuongtk2 342]

Anh cũng không rõ lắm, chắc do mấy cái hàm nó bị lẫn, em thử load từng đoạn vào xem , đếm đủ bằng nhau số ngoặc đơn () cho từng đoạn để load khỏi lỗi. Anh cũng không có máy khác để test.

[alisp 72]

38 phút trước, cuongtk2 đã nói:

Anh cũng không rõ lắm, chắc do mấy cái hàm nó bị lẫn, em thử load từng đoạn vào xem , đếm đủ bằng nhau số ngoặc đơn () cho từng đoạn để load khỏi lỗi. Anh cũng không có máy khác để test.

Thiếu hàm list_point_pline rồi bác.

[cuongtk2 342]

(defun c:hcncheo( / ANG ANG1 DIST E ENT ENTS H L1 L2 LISTDINH NAME OBJ P1 P2 P3 P4 P5 P6 PARAM PE PS PT)
(setq ents (entsel "\nPick entity"))
(if (null ents) (exit))
(setq pt (cadr ents)
      ent (car ents)
      name (acet-dxf 0 (entget ent)))
(if (null (or (= name "LWPOLYLINE")
	(= name "LINE"))
	  )
  (exit)
  )
(if (= name "LWPOLYLINE")
(setq obj (vlax-ename->vla-object ent)
      pt (vlax-curve-getclosestpointto obj pt)
      param (fix (vlax-curve-getParamAtPoint obj pt))
      ps (vlax-curve-getPointAtParam obj param)
      pe (vlax-curve-getPointAtParam obj (+ param 1))
      )
  )
(if (= name "LINE")
  (setq ps (acet-dxf 10 (entget ent))
	pe (acet-dxf 11 (entget ent))
	)
  )

(setq p1 (if (< (car ps) (car pe)) ps pe)
      p2 (if (< (car ps) (car pe)) pe ps)
      ang (angle p1 p2)
      ang1 (+ ang (* pi 0.5))
      dist (DISTANCE p1 p2))
(alert (strcat "L= "  (rtos dist 2 2)))
(setq l1 (getdist "\nL1:"))
(setq l2 (getdist "\nL2:"))
(if (> (+ l1 l2) dist)
  (alert "Tong L1 + L2  qua lon")
  )
(setq h (getdist "\nH:"))

(setq p3 (polar p1 ang l1)
      p4 (polar p2 ang (- 0 l2))
      p5 (polar p4 ang1 h)
      p6 (polar p3 ang1 h)
      )
(DEFUN list_point_pline  (p1 w)
  (LIST (LIST 10 (CAR p1) (CADR p1)) (CONS 40 w) (CONS 41 w) (CONS 42 0.0))
  )
(DEFUN make_lwpolyline  (list_dinh dong_lai do_day layer / dlist elist1 e_list n i)
  (SETQ n (LENGTH list_dinh))
  (SETQ dlist nil)
  (SETQ i 0)
  (WHILE (< i n)
    (SETQ dlist (APPEND dlist
                        (list_point_pline (NTH i list_dinh) do_day)
                        )
          )
    (SETQ i (1+ i))
    )

  (SETQ elist1 (LIST (CONS 0 "LWPOLYLINE")
                     (CONS 100 "AcDbEntity")
                     (CONS 410 "Model")
                     (CONS 8 layer)
                     (CONS 100 "AcDbPolyline")
                     (CONS 90 n)
                     (CONS 70 dong_lai)
 ;(cons 43 0.0)
                     (CONS 38 0.0)
                     (CONS 39 0.0)))
  (SETQ e_list nil)
  (SETQ e_list (APPEND elist1 dlist))
  (SETQ e_list (APPEND e_list (LIST '(210 0.0 0.0 1.0))))
  (ENTMAKE e_list)
  )

(DEFUN make_dim_y1  (style p1 p2 p3  ang layer / d e_list basepoint p4)
  
  (SETQ e_list (LIST
                 (CONS 0 "DIMENSION")
                 (CONS 100 "AcDbEntity")
                 (CONS 67 0)
                 (CONS 410 "Model")
                 (CONS 8 layer)
                 (CONS 100 "AcDbDimension")
                 (cons 10 p3)
                 (cons 11 p3)
                 (LIST 12 0.0 0.0 0.0)
                 (CONS 70 32)
                 (CONS 1 "")
                 (CONS 71 5)
                 (CONS 72 1)
                 (CONS 41 1.0)
                 (CONS 42 0)
                 (CONS 52 0.0)
                 (CONS 53 0.0)
                 (CONS 54 0.0)
                 (CONS 51 0.0)
                 (LIST 210 0.0 0.0 1.0)
                 (CONS 3 style)
                 (CONS 100 "AcDbAlignedDimension")
                 (cons 13 p1)
                 (cons 14 p2)
                 (LIST 15 0.0 0.0 0.0)
                 (LIST 16 0.0 0.0 0.0)
                 (CONS 40 0.0)
                 (CONS 50 ang)
                 (CONS 100 "AcDbRotatedDimension")
		 )
        )
  (ENTMAKE e_list)


  )

(setq listdinh (mapcar '(lambda (e) (list (car e) (cadr e))
			  )
		       (list p3 p4 p5 p6))
      )
(MAKE_LWPOLYLINE listdinh 1 0 "chunhat")

(MAKE_DIM_Y1 "Standard" p3 p6 (polar p1 (- 0 ang) (+ h h)) ang1 "dim")
(MAKE_DIM_Y1 "Standard" p1 p3 (polar p1 ang1 (+ h h)) ang  "dim")
(MAKE_DIM_Y1 "Standard" p4 p2 (polar p1 ang1 (+ h h)) ang  "dim")


)

thử lại nhé

[zutum 0]

dạ cảm ơn anh nhiều. Lisp đã hoạt động rồi nhưng có 2 điểm em mong anh giúp em thêm nữa.

1: anh bỏ đường dim dùm em nhé. Không cần đường dim cũng được anh. Với nó tạo 1 layer mới chữ nhật có thể dùng layer hiện hành luôn được không anh. Còn nếu khó thì để layer chữ nhật như vậy cũng đươc.

2: Anh giúp em chọn hướng của hình chữ nhật luôn anh. Như hình em up dưới cái hình chữ nhật nó chạy lung tung lúc ở trong hình vuông ( chữ nhật ) lúc ở ngoài hình vuông ( chữ nhật ). 

 

 

 

[cuongtk2 342]

Tìm trong code thấy chữ "chunhat" thì thay bằng layer tùy ý "XXXX", Nếu muốn layer hiện hành thì thay bằng (getvar "Clayer").

Xóa dim thì xóa mấy dòng make_dim là được.

Code anh không lưu nên nhác sửa.

[zutum 0]

dạ cảm ơn anh.  Cái ý 1 thì để em tự mò làm cũng được.

Còn cái quan trọng là cái 2 đó anh. Do k biết nó sẽ nằm trong hay ngoài hình. Mình thêm câu lệnh gì vào để nó được như ý mình anh .

Vì muốn ngoài mà nó hiện ở trong thì phải thêm 1 công đoạn move ra ngoài nữa và ngược lại.  

 

[alisp 72]

Bạn thử cái này, hình chữ nhật luôn nằm bên trái của hướng từ điểm đầu tới điểm cuối.

VCN.lsp

[zutum 0]

nó chạy rồi bạn . thanks bạn nhiều. Cảm ơn @cuongtk2  @alisp  rất nhiều.