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

[toiyeuvietnam 0]

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:

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

 

[nguyenhiepktxdct 0]

sao k dùng lệnh tcount nhỉ :/

[ketxu 2.984]

(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.

 

[toiyeuvietnam 0]

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! 

[hanh.phuc 5]

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

[ketxu 2.984]

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

[hanh.phuc 5]

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 optimized vì vlx

 

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

[ketxu 2.984]

Và vì cả Debug nữa ^_^

[ndtnv 481]

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