Đến nội dung


Hình ảnh
- - - - -

[Xin Giúp Đỡ]Lisp Thay Đổi Giá Trị Att Theo Điều Kiện


  • Please log in to reply
4 replies to this topic

#1 lohado

lohado

    biết lệnh erase

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

Đã gửi 28 July 2016 - 02:32 PM

Công việc của e yêu cầu chỉnh sửa Block này rất nhiều,thủ công thì mất nhiều thời gian và nhàm chán.nay nhờ các anh viết giúp e lisp chỉnh sửa tự động att này

-việc của e yêu cầu chỉnh sửa Att tag là E trong block HABA theo giá trị được gán

-Giá trị att đó được tính bằng Field

-Trong bản vẽ còn có thể có nhiều block att khác nhưng chỉ cần chỉnh sửa trong block HABA kia thôi

Yêu cầu là

giá trị <=40,chuyển thành F07

40<giá trị <=95,chuyển thành F12

95<giá trị <=150,chuyển thành F18

150<giá trị <=200,chuyển thành F23

 

Mong tin tốt từ các bác

(File đính kèm)

http://www.cadviet.c..._drawing2_1.dwg


  • 0

    146106_untitled444_2.png


#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 29 July 2016 - 02:05 PM

gửi bạn. lệnh là a1

Bạn xem rồi sửa lại các điều kiện biên cho đúng (bản vẽ điều kiện <, yêu cầu trên 4r lại là <= )

(defun c:a1( / k CV:ss-to-list)
  (defun CV:ss-to-list (ss vla / n e l)
    (if	ss
      (progn
	(setq n (sslength ss))
	(while (setq e (ssname ss (setq n (1- n))))
	  (setq	l (cons	(if vla
			  (vlax-ename->vla-object e)
			  e
			)
			l
		  )
	  )
	)
      )
    )
  )
  (command ".undo" "be")
  (mapcar '(lambda (y)
	      (mapcar '(lambda (x)
			 (if (and (= (vla-get-tagstring x) "E")
				  (distof(setq k (vla-get-textstring x)))
				  )
			   (progn
			     (setq k (atof k))
			     (cond
			       ((<= k 40)(vla-put-textstring x "F07"))
			       ((<= k 95)(vla-put-textstring x "F12"))
			       ((<= k 150)(vla-put-textstring x "F18"))
			       ((<= k 200)(vla-put-textstring x "F23"))
			       )
			     )
			   )
			 
			 )(vlax-invoke y 'GetAttributes))
	      )
	   (CV:ss-to-list (SSGET (list (cons 0  "INSERT")(cons 2 "HABA")(cons 66 1))) t)
   )
  (command ".undo" "en")
  (princ)
  )

  • 1

#3 lohado

lohado

    biết lệnh erase

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

Đã gửi 02 August 2016 - 08:14 AM

 

gửi bạn. lệnh là a1

Bạn xem rồi sửa lại các điều kiện biên cho đúng (bản vẽ điều kiện <, yêu cầu trên 4r lại là <= )

(defun c:a1( / k CV:ss-to-list)
  (defun CV:ss-to-list (ss vla / n e l)
    (if	ss
      (progn
	(setq n (sslength ss))
	(while (setq e (ssname ss (setq n (1- n))))
	  (setq	l (cons	(if vla
			  (vlax-ename->vla-object e)
			  e
			)
			l
		  )
	  )
	)
      )
    )
  )
  (command ".undo" "be")
  (mapcar '(lambda (y)
	      (mapcar '(lambda (x)
			 (if (and (= (vla-get-tagstring x) "E")
				  (distof(setq k (vla-get-textstring x)))
				  )
			   (progn
			     (setq k (atof k))
			     (cond
			       ((<= k 40)(vla-put-textstring x "F07"))
			       ((<= k 95)(vla-put-textstring x "F12"))
			       ((<= k 150)(vla-put-textstring x "F18"))
			       ((<= k 200)(vla-put-textstring x "F23"))
			       )
			     )
			   )
			 
			 )(vlax-invoke y 'GetAttributes))
	      )
	   (CV:ss-to-list (SSGET (list (cons 0  "INSERT")(cons 2 "HABA")(cons 66 1))) t)
   )
  (command ".undo" "en")
  (princ)
  )

Cảm ơn bác rất nhiều.bác có thể ghi chú từng dòng trong lisp giúp e xem nó có ý nghĩa ntn đc ko?e đang mày mò về lisp,nên muốn hiểu mấy cái thực tế như thế này.hì


  • 0

    146106_untitled444_2.png


#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 02 August 2016 - 11:58 AM

Cảm ơn bác rất nhiều.bác có thể ghi chú từng dòng trong lisp giúp e xem nó có ý nghĩa ntn đc ko?e đang mày mò về lisp,nên muốn hiểu mấy cái thực tế như thế này.hì

Hề hề hề,

Bạn có thể tham khảo cái này chăng;

 

http://www.cadviet.c...teattribute.lsp

(defun c:upat (/ elst e a als) 
(setq elst (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 2 "haba"))))) ;;;; Lấy danh sách tên các block có tên HABA
(foreach e elst                                                                                          ;;;; Duyệt qua danh sách này
    (setq a (entnext e) als (entget a))                                                        ;;;;; Lấy các đối tượng thuộc block
    (while (and a (/= (cdr (assoc 0 als)) "SEQEND"))
            (if (and (= (cdr (assoc 2 als)) "E") (/= (substr (cdr(assoc 1 als)) 1 1) "F") ) ;;;;; Chon thuộc tính cần xủ lý
                (progn
                    (setq a nil)
                    ( cond 
                          ((< (atof (cdr (assoc 1 als))) 40) (setq als (subst (cons 1 "F07") (assoc 1 als) als)))
                          (( and (>= (atof (cdr (assoc 1 als))) 40) (< (atof (cdr (assoc 1 als))) 95)  ) (setq als (subst (cons 1 "F12") (assoc 1 als) als)))
                          (( and (>= (atof (cdr (assoc 1 als))) 95) (< (atof (cdr (assoc 1 als))) 150) ) (setq als (subst (cons 1 "F18") (assoc 1 als) als)))
                          (( and (>= (atof (cdr (assoc 1 als))) 150) (< (atof (cdr (assoc 1 als))) 200) ) (setq als (subst (cons 1 "F23") (assoc 1 als) als)))
                          (T nil)
                    )
                 )
                 (progn 
                     (setq a (entnext a) )
                     (setq als (entget a))
                 )
             )
       )
       (entmod als) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cập nhật thuộc tính đã xử lý
       (entupd e)    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cập nhật block
)
)

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 lohado

lohado

    biết lệnh erase

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

Đã gửi 03 August 2016 - 11:52 AM

 

Hề hề hề,

Bạn có thể tham khảo cái này chăng;

 

http://www.cadviet.c...teattribute.lsp

(defun c:upat (/ elst e a als) 
(setq elst (acet-ss-to-list (ssget (list (cons 0 "insert") (cons 2 "haba"))))) ;;;; Lấy danh sách tên các block có tên HABA
(foreach e elst                                                                                          ;;;; Duyệt qua danh sách này
    (setq a (entnext e) als (entget a))                                                        ;;;;; Lấy các đối tượng thuộc block
    (while (and a (/= (cdr (assoc 0 als)) "SEQEND"))
            (if (and (= (cdr (assoc 2 als)) "E") (/= (substr (cdr(assoc 1 als)) 1 1) "F") ) ;;;;; Chon thuộc tính cần xủ lý
                (progn
                    (setq a nil)
                    ( cond 
                          ((< (atof (cdr (assoc 1 als))) 40) (setq als (subst (cons 1 "F07") (assoc 1 als) als)))
                          (( and (>= (atof (cdr (assoc 1 als))) 40) (< (atof (cdr (assoc 1 als))) 95)  ) (setq als (subst (cons 1 "F12") (assoc 1 als) als)))
                          (( and (>= (atof (cdr (assoc 1 als))) 95) (< (atof (cdr (assoc 1 als))) 150) ) (setq als (subst (cons 1 "F18") (assoc 1 als) als)))
                          (( and (>= (atof (cdr (assoc 1 als))) 150) (< (atof (cdr (assoc 1 als))) 200) ) (setq als (subst (cons 1 "F23") (assoc 1 als) als)))
                          (T nil)
                    )
                 )
                 (progn 
                     (setq a (entnext a) )
                     (setq als (entget a))
                 )
             )
       )
       (entmod als) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cập nhật thuộc tính đã xử lý
       (entupd e)    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cập nhật block
)
)

hì.Có câu hỏi ko liên quan lắm,bác có thể giải thích cho e cặn kẽ về lambda và mapcar đc ko ạ?e hay thấy quá mà tìm thấy toàn tài liệu tiếng Anh nên ko hiểu lắm.Thêm ví dụ ứng dụng nữa thì quá tuyệt ạ :D


  • 0

    146106_untitled444_2.png