Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
taipham

Nhờ Viết Lisp Lấy Nội Dung Linetype Gán Vào Block Att

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

Nhờ các anh chị trong diễn đàn viết hộ em lisp lấy nội dung của đường linetype chọn và gán vào block ATT

Thao tác như sau: đánh lệnh CCL -> chọn đường Line hoặc Pline có giá trị linetype -> chọn các block ATT muốn gán nội dung vào. Đây là file minh họa, mong được các anh chị giúp đỡ!

http://www.cadviet.com/upfiles/5/146422_nho_viet_lisp.dwg

Xin cảm ơn!

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

code nhanh cho Bạn. Lệnh là GNL, chọn và update lien tục các tên của linetype vào block, khi muốn kết thúc thì enter

(defun c:GNL (/ e b lay nam);get name linetype
  
  (while (and
	   (princ "\nChon Line, PLINE")
	   (setq e (ssget '((0 . "*LINE"))))
	   (princ "\nChon block")
	   (setq b (ssget '((0 . "insert") (66 . 1))))
	 )

    (setq lay (cdr (assoc 8 (setq e (entget (ssname e 0))))))
    (if	(not (setq nam (cdr (assoc 6 e))))
      (setq nam (cdr (assoc 6 (tblsearch "LAYER" lay))))
    )
    (mapcar
      '(lambda (x)
	 (mapcar
	   '(lambda (Att)
	      (if
		(= (strcase (vla-get-TagString att)) "2T2K")
		 (vla-put-textstring att nam)
	      )
	    )
	   (vlax-invoke (vlax-ename->vla-object x) 'GetAttributes)

	 )
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex b)))
    )

  )
  (princ)
  )
  • 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

 

code nhanh cho Bạn. Lệnh là GNL, chọn và update lien tục các tên của linetype vào block, khi muốn kết thúc thì enter

(defun c:GNL (/ e b lay nam);get name linetype
  
  (while (and
	   (princ "\nChon Line, PLINE")
	   (setq e (ssget '((0 . "*LINE"))))
	   (princ "\nChon block")
	   (setq b (ssget '((0 . "insert") (66 . 1))))
	 )

    (setq lay (cdr (assoc 8 (setq e (entget (ssname e 0))))))
    (if	(not (setq nam (cdr (assoc 6 e))))
      (setq nam (cdr (assoc 6 (tblsearch "LAYER" lay))))
    )
    (mapcar
      '(lambda (x)
	 (mapcar
	   '(lambda (Att)
	      (if
		(= (strcase (vla-get-TagString att)) "2T2K")
		 (vla-put-textstring att nam)
	      )
	    )
	   (vlax-invoke (vlax-ename->vla-object x) 'GetAttributes)

	 )
       )
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex b)))
    )

  )
  (princ)
  )

Cảm ơn anh nhiều nhé!

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

Đăng nhập để thực hiện theo  

×