HELP !! Nhờ các cao thủ lisp nối tâm Block thành đường Polyline

[minhmani 1]

Chào các bác, mong các bác tạo giúp mình 1 lisp như sau:

- Mình đang có 3 loại Block Attribute, tên lần lượt là NoteCRSR, NoteCRSA, NoteCRSB

- Sau khi mình dùng lisp "ND" để quét các Block trên sẽ tạo ra 3 đường polyline nối tâm lần lượt 3 Block trên  

- Đường Polyline nào thì sẽ có tên Layer ứng với 3 block trên. Ví dụ:

+ Block NoteCRSR ứng với Layer: Noi diem 1

+ Block NoteCRSA ứng với Layer: Noi diem 2

+ Block NoteCRSB ứng với Layer: Noi diem 3

 

Cụ thể mình có thể hiện trong bản Cad đi kèm. Mong các bác giúp đỡ :D

MAU.dwg

Chỉnh sửa Tháng 9 11, 2020 theo minhmani
ghi thiếu ý

[NguoiTrongAoHo 0]

3 giờ trước, minhmani đã nói:

Chào các bác, mong các bác tạo giúp mình 1 lisp như sau:

- Mình đang có 3 loại Block Attribute, tên lần lượt là NoteCRSR, NoteCRSA, NoteCRSB

- Sau khi mình dùng lisp "ND" để quét các Block trên sẽ tạo ra 3 đường polyline nối tâm lần lượt 3 Block trên  

- Đường Polyline nào thì sẽ có tên Layer ứng với 3 block trên. Ví dụ:

+ Block NoteCRSR ứng với Layer: Noi diem 1

+ Block NoteCRSA ứng với Layer: Noi diem 2

+ Block NoteCRSB ứng với Layer: Noi diem 3

 

Cụ thể mình có thể hiện trong bản Cad đi kèm. Mong các bác giúp đỡ :D

MAU.dwg

Nếu theo mẫu sắp xếp nối theo trục Y thì oki, Tôi có thể giúp bạn nhưng  vì bạn chỉ nhờ cao thủ vậy nên tôi rất tiếc, tôi không phải cao thủ.

[ngokiet 169]

(defun c:nd(/ ss tt st i)
  (or (setq ss (vl-sort (mapcar '(lambda(x) (cons (vla-get-EffectiveName (setq x (vlax-ename->vla-object x)))
					          (vlax-safearray->list(vlax-variant-value(vla-get-insertionpoint x)))))
			         (acet-ss-to-list (ssget '((0 . "INSERT")))))
		        '(lambda(x y) (if (eq (car x) (car y)) (< (caddr x) (caddr x)) (< (car x) (car y))))))
      (exit))
  (setq tt (list (car ss))
	i 1)
  (foreach x (append (cdr ss) '(nil))
    (if (eq (car x) (caar tt)) (setq tt (cons x tt))
      (progn
	(or (tblsearch "LAYER" (setq st (strcat "Noi Diem " (itoa i))))
	    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
			   (cons 2 st) '(70 . 0))))
	(entmakex (vl-list* '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 st) '(100 . "AcDbPolyline")
				(cons 90 (length tt)) '(70 . 0)
			    (mapcar '(lambda (x)(cons 10 (cdr x))) tt)))
	(setq tt (list x)
	      i  (1+ i)))))
  (princ))

Viết nhanh .Sài đỡ.

[minhmani 1]

Quote

Quote

 

Viết nhanh .Sài đỡ.

cám ơn bác ngokiet nhiều, lisp xài ổn lắm bác

Quote

Nếu theo mẫu sắp xếp nối theo trục Y thì oki, Tôi có thể giúp bạn nhưng  vì bạn chỉ nhờ cao thủ vậy nên tôi rất tiếc, tôi không phải cao thủ.

Bác bắt bẻ nhau quá :D. Quen mồm xin vậy thôi mà.

[TonyDSK 1]

Quote

Vào lúc 12/9/2020 tại 12:18, ngokiet đã nói:

(defun c:nd(/ ss tt st i)
  (or (setq ss (vl-sort (mapcar '(lambda(x) (cons (vla-get-EffectiveName (setq x (vlax-ename->vla-object x)))
					          (vlax-safearray->list(vlax-variant-value(vla-get-insertionpoint x)))))
			         (acet-ss-to-list (ssget '((0 . "INSERT")))))
		        '(lambda(x y) (if (eq (car x) (car y)) (< (caddr x) (caddr x)) (< (car x) (car y))))))
      (exit))
  (setq tt (list (car ss))
	i 1)
  (foreach x (append (cdr ss) '(nil))
    (if (eq (car x) (caar tt)) (setq tt (cons x tt))
      (progn
	(or (tblsearch "LAYER" (setq st (strcat "Noi Diem " (itoa i))))
	    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")'(100 . "AcDbLayerTableRecord")
			   (cons 2 st) '(70 . 0))))
	(entmakex (vl-list* '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 st) '(100 . "AcDbPolyline")
				(cons 90 (length tt)) '(70 . 0)
			    (mapcar '(lambda (x)(cons 10 (cdr x))) tt)))
	(setq tt (list x)
	      i  (1+ i)))))
  (princ))

Viết nhanh .Sài đỡ.

Bác giúp em mình nối các tâm block theo hướng như trong file mẫu em gửi đc không. Mong bác giúp đỡ!

 

mau1.dwg