Chuyển đến nội dung
Diễn đàn CADViet
toiyeuvietnam

[Yêu cầu] Nhờ các bác viết giúp em cái lisp đánh số thứ tự từ trái

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

Nhờ các bác viết giúp em cái lisp đánh số thứ tự từ trái qua phải hoặc từ phải qua trái vào giữa đối tượng Closed Poline như hình vẽ minh họa và file đính kèm dưới đây:

89068_ban_ve.jpghttp://www.cadviet.com/upfiles/3/89068_ban_ve.dwg

 

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

(defun c:atrai()(add <=))
(defun c:aphai()(add >=))
(defun add(dir / i  ss h _cen _t _sort)
	(defun _cen (v / p1 p2)
		(vla-getboundingbox (vlax-ename->vla-object v) 'p1 'p2)
		(mapcar '* (mapcar '+ (vlax-safearray->list p1) (vlax-safearray->list p2)) '(0.5 0.5 0.5))		
	)
	(defun _t (?where p s h / o )
		(setq o (vla-addtext ?where s (setq p (vlax-3D-point p)) h))
		(vla-put-alignment o acalignmentmiddlecenter)
		(vla-put-textalignmentpoint o p)    
	 )
	(defun _sort(f lst)(vl-sort lst '(lambda(x y)(f (car x) (car y)))))
	(setq 	i 0		 
			sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
			ss (ssget '((0 . "LWPOLYLINE")(70 . 1)))
			h (getvar 'Textsize)			 
	)
	(mapcar
		'(lambda(c)(_t sp c (itoa (setq i (1+ i))) h))	
			(_sort dir (mapcar '_cen (acet-ss-to-list ss)))
	)
	(princ)
) 

 

Quick code cho bạn. Vì khái niệm tâm rất mơ hồ, mình sẽ lấy tạm là tâm của boundingbox đối tượng, add chữ Dtext như bản vẽ, chiều cao lấy theo biến hệ thống Textsize.

 

  • 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

oh, tuyệt vời quá anh Ket ạ mặc dù có 1 vài số thứ tự chưa được vào tâm nhưng như vậy cùng là tốt rồi. cảm ơn anh rất nhiều!

thay thế (defun _cen ...... )

----------------------------------


(defun _cen (e)

((lambda (lst /)

(mapcar ''(( c ) (/ c (length lst)))

('((lst / ans l)

(setq v (car lst) l (cdr lst))

(while l (setq v (mapcar ''((a B) (float (+ a B))) v (car l)) l (cdr l)))

v ) lst)) ;_ end of mapcar

) ;_ end of lambda

(mapcar 'cdr (vl-remove-if-not ''((x) (= (car x) 10)) (entget e))

) ;_ end of mapcar

) ; load

) ;_ end of defun

  • 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

Tks hanhphuc vì kiểu viết quote quote, nhìn hơi rối n đảm bảo khó decode ^^ Nhưng chắc bạn chưa test tại sao có những lúc nó chưa được vào tâm  của OP :)

p/s : lại gặp lại :)

  • Vote tăng 1

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

kiểu viết quote quote là kiểu viết lười biếng :)
(function (lambda (x) (expression x) ))  là ''((x) (expression x) ) , nhưng chú ý : quote quote lambda not optimizedvlx

 

nice to meet , cảm ơn bạn  :)

  • Vote tăng 1

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

Bổ sung để khả năng cen nằm trong pline cao hơn:

 

(defun _cen (v / p1 p2 p u)
        (vla-getboundingbox (setq v (vlax-ename->vla-object v)) 'p1 'p2)
        (setq p (mapcar '* (mapcar '+ (vlax-safearray->list p1) (vlax-safearray->list p2)) '(0.5 0.5 0.5)))
    (setq u (entmakex (list '(0 . "LINE") (cons 10 p)(cons 11 (polar p (/ pi 2) 1)))))
    (setq    p    (vlax-invoke v 'IntersectWith (vlax-ename->vla-object u) 2)    )
    (entdel u)
    (list (car p) (/ (+ (cadr p)(nth 4 p))2) (caddr p))
)
  • 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

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


×