Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 25 November 2015 - 03:54 PM

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.c...o_viet_lisp.dwg

Xin cảm ơn!


  • 0

#2 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 25 November 2015 - 07:49 PM

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

  • 2

#3 taipham

taipham

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: -5 (bình thường)

Đã gửi 26 November 2015 - 08:19 AM

 

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é!


  • 0