Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
8 replies to this topic

#1 toiyeuvietnam

toiyeuvietnam

    biết vẽ polygon

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

Đã gửi 14 August 2014 - 09:39 PM

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.c...9068_ban_ve.dwg

 


  • 0

#2 nguyenhiepktxdct

nguyenhiepktxdct

    Chưa sử dụng CAD

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

Đã gửi 15 August 2014 - 12:27 PM

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


  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 August 2014 - 05:53 PM

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


  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 toiyeuvietnam

toiyeuvietnam

    biết vẽ polygon

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

Đã gửi 17 August 2014 - 12:04 AM

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! 


  • 0

#5 hanh.phuc

hanh.phuc

    Chưa sử dụng CAD

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

Đã gửi 17 August 2014 - 12:46 PM

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

  • 2

( apply '= "hp" "happy" "hạnh phúc" "幸福" "행복" ) ; error: too many arguments


#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 August 2014 - 01:43 PM

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


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 hanh.phuc

hanh.phuc

    Chưa sử dụng CAD

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

Đã gửi 17 August 2014 - 08:25 PM

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


  • 1

( apply '= "hp" "happy" "hạnh phúc" "幸福" "행복" ) ; error: too many arguments


#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 17 August 2014 - 09:53 PM

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


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 18 August 2014 - 11:33 AM

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

  • 2