Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] sắp xếp text


  • Please log in to reply
26 replies to this topic

#1 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 27 August 2013 - 02:26 PM

Đây là lisp mình lấy từ diễn đàn cadviet của bác Tue_NV và chỉnh sửa thêm 1 tí nhưng bị lỗi nhờ mọi người giúp đỡ 

để mình nói sơ qua ý tưởng của mình đây là lisp sắp xếp text bây giờ mình muốn lọc các giá trị text trước khi sắp xếp, cụ thể là các giá trị text bằng nhau (cao độ bằng nhau) chỉ lấy 1 giá trị đầu tiên các giá trị khác sẽ bị xoá sau đó mới sắp xếp lại text.

đây là lisp 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=560
(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))))
(setq kc (getdist (strcat "\n Khoang cach giua cac Text <" (rtos kco 2 2) "> :")))
(if (not kc) (setq kc kco) (setq kco kc))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Phan xu ly gia tri text bang nhau do minh viet dang bi loi
;(defun xoatext( ss / nhom tam i j sdtc sslst)
  (setq nhom (ssadd))
  (setq sdtc (ssadd))
  (setq i 0)
  (repeat (sslength ss)
    (setq tam (ssname ss 0))
    (setq j 1)
    (repeat (- (sslength ss) 1)
     (if (/= (ssname ss j) nil)
	  (progn
	  (if (= (cdr (assoc 1 (entget tam)))
			   (cdr (assoc 1 (entget (ssname ss j)))) )
	    (progn
	      (setq nhom (ssadd (ssname ss j) nhom))
	      (setq ss (ssdel (ssname ss j) ss))
		  )
	  )
	  )
      )
      (setq j (+ j 1))
    )
    (if	(/= tam nil)
	  (progn
      (setq ss (ssdel tam ss))
	  (setq sdtc (ssadd tam sdtc)) 
	  )
    )
    (setq i (+ i 1))
  )
  (command "ERASE" nhom "" )
  ;(setq ss (acet-ss-to-list sdtc))
  (setq ss sdtc)
 ;;;;;;;;;;;;;;;;;;;;;;;; ket thuc phan xu ly text 
 ;;;;;;;;;;;;;;;;;;;;;;;
(while (< i (sslength ss))
	(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
	(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
	(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
			'(lambda (x y)
				(< (caaar x) (caaar y))
			 )
	      )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))

(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
    (progn
	(setq i (- i 0.5)) (setq j 0) 
	(foreach x lisobj
		(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
		(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
		(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
		(setq i (1- i)) (setq j (1+ j))

       )
    )

(princ )
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...ic=13203&st=560
(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))))
(setq kc (getdist (strcat "\n Khoang cach giua cac Text <" (rtos kco 2 2) "> :")))
(if (not kc) (setq kc kco) (setq kco kc))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Phan xu ly gia tri text bang nhau do minh viet dang bi loi
;(defun xoatext( ss / nhom tam i j sdtc sslst)
  (setq nhom (ssadd))
  (setq sdtc (ssadd))
  (setq i 0)
  (repeat (sslength ss)
    (setq tam (ssname ss 0))
    (setq j 1)
    (repeat (- (sslength ss) 1)
     (if (/= (ssname ss j) nil)
 (progn
 (if (= (cdr (assoc 1 (entget tam)))
  (cdr (assoc 1 (entget (ssname ss j)))) )
   (progn
     (setq nhom (ssadd (ssname ss j) nhom))
     (setq ss (ssdel (ssname ss j) ss))
 )
 )
 )
      )
      (setq j (+ j 1))
    )
    (if (/= tam nil)
 (progn
      (setq ss (ssdel tam ss))
 (setq sdtc (ssadd tam sdtc)) 
 )
    )
    (setq i (+ i 1))
  )
  (command "ERASE" nhom "" )
  ;(setq ss (acet-ss-to-list sdtc))
  (setq ss sdtc)
 ;;;;;;;;;;;;;;;;;;;;;;;; ket thuc phan xu ly text 
 ;;;;;;;;;;;;;;;;;;;;;;;
(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caaar x) (caaar y))
)
     )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))
 
(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
    (progn
(setq i (- i 0.5)) (setq j 0) 
(foreach x lisobj
(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
(setq i (1- i)) (setq j (1+ j))
 
       )
    )
 
(princ )
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...ic=13203&st=560
(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))))
(setq kc (getdist (strcat "\n Khoang cach giua cac Text <" (rtos kco 2 2) "> :")))
(if (not kc) (setq kc kco) (setq kco kc))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Phan xu ly gia tri text bang nhau do minh viet dang bi loi
;(defun xoatext( ss / nhom tam i j sdtc sslst)
  (setq nhom (ssadd))
  (setq sdtc (ssadd))
  (setq i 0)
  (repeat (sslength ss)
    (setq tam (ssname ss 0))
    (setq j 1)
    (repeat (- (sslength ss) 1)
     (if (/= (ssname ss j) nil)
 (progn
 (if (= (cdr (assoc 1 (entget tam)))
  (cdr (assoc 1 (entget (ssname ss j)))) )
   (progn
     (setq nhom (ssadd (ssname ss j) nhom))
     (setq ss (ssdel (ssname ss j) ss))
 )
 )
 )
      )
      (setq j (+ j 1))
    )
    (if (/= tam nil)
 (progn
      (setq ss (ssdel tam ss))
 (setq sdtc (ssadd tam sdtc)) 
 )
    )
    (setq i (+ i 1))
  )
  (command "ERASE" nhom "" )
  ;(setq ss (acet-ss-to-list sdtc))
  (setq ss sdtc)
 ;;;;;;;;;;;;;;;;;;;;;;;; ket thuc phan xu ly text 
 ;;;;;;;;;;;;;;;;;;;;;;;
(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caaar x) (caaar y))
)
     )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))
 
(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
    (progn
(setq i (- i 0.5)) (setq j 0) 
(foreach x lisobj
(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
(setq i (1- i)) (setq j (1+ j))
 
       )
    )
 
(princ )
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...ic=13203&st=560
(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))))
(setq kc (getdist (strcat "\n Khoang cach giua cac Text <" (rtos kco 2 2) "> :")))
(if (not kc) (setq kc kco) (setq kco kc))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Phan xu ly gia tri text bang nhau do minh viet dang bi loi
;(defun xoatext( ss / nhom tam i j sdtc sslst)
  (setq nhom (ssadd))
  (setq sdtc (ssadd))
  (setq i 0)
  (repeat (sslength ss)
    (setq tam (ssname ss 0))
    (setq j 1)
    (repeat (- (sslength ss) 1)
     (if (/= (ssname ss j) nil)
 (progn
 (if (= (cdr (assoc 1 (entget tam)))
  (cdr (assoc 1 (entget (ssname ss j)))) )
   (progn
     (setq nhom (ssadd (ssname ss j) nhom))
     (setq ss (ssdel (ssname ss j) ss))
 )
 )
 )
      )
      (setq j (+ j 1))
    )
    (if (/= tam nil)
 (progn
      (setq ss (ssdel tam ss))
 (setq sdtc (ssadd tam sdtc)) 
 )
    )
    (setq i (+ i 1))
  )
  (command "ERASE" nhom "" )
  ;(setq ss (acet-ss-to-list sdtc))
  (setq ss sdtc)
 ;;;;;;;;;;;;;;;;;;;;;;;; ket thuc phan xu ly text 
 ;;;;;;;;;;;;;;;;;;;;;;;
(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caaar x) (caaar y))
)
     )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))
 
(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
    (progn
(setq i (- i 0.5)) (setq j 0) 
(foreach x lisobj
(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
(setq i (1- i)) (setq j (1+ j))
 
       )
    )
 
(princ )
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)
 
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...ic=13203&st=560
(defun c:sxtt(/ ss kc i obj lispobj lisdau lisobj diemBcuoi tdi spt des)
(vl-load-com)
;copyright by Tue_NV
(setq ss (ssget '((0 . "*TEXT"))) i 0 lispobj (list))
(if (not kco) (setq kco (cdr(assoc 40 (entget(ssname ss 0))))))
(setq kc (getdist (strcat "\n Khoang cach giua cac Text <" (rtos kco 2 2) "> :")))
(if (not kc) (setq kc kco) (setq kco kc))
;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; Phan xu ly gia tri text bang nhau do minh viet dang bi loi
;(defun xoatext( ss / nhom tam i j sdtc sslst)
  (setq nhom (ssadd))
  (setq sdtc (ssadd))
  (setq i 0)
  (repeat (sslength ss)
    (setq tam (ssname ss 0))
    (setq j 1)
    (repeat (- (sslength ss) 1)
     (if (/= (ssname ss j) nil)
 (progn
 (if (= (cdr (assoc 1 (entget tam)))
  (cdr (assoc 1 (entget (ssname ss j)))) )
   (progn
     (setq nhom (ssadd (ssname ss j) nhom))
     (setq ss (ssdel (ssname ss j) ss))
 )
 )
 )
      )
      (setq j (+ j 1))
    )
    (if (/= tam nil)
 (progn
      (setq ss (ssdel tam ss))
 (setq sdtc (ssadd tam sdtc)) 
 )
    )
    (setq i (+ i 1))
  )
  (command "ERASE" nhom "" )
  ;(setq ss (acet-ss-to-list sdtc))
  (setq ss sdtc)
 ;;;;;;;;;;;;;;;;;;;;;;;; ket thuc phan xu ly text 
 ;;;;;;;;;;;;;;;;;;;;;;;
(while (< i (sslength ss))
(vla-getboundingbox (setq obj (vlax-ename->vla-object (ssname ss i))) 'bl 'tl)
(setq lispobj (cons (cons (list (safearray-value tl) (safearray-value bl)) obj) lispobj))
(setq i (1+ i))
)
(setq lispobj (vl-sort lispobj
'(lambda (x y)
(< (caaar x) (caaar y))
)
     )
)
(setq lisdau (mapcar 'caar lispobj))
;(setq liscuoi (mapcar 'cadar lispobj))
(setq lisobj (mapcar 'cdr lispobj))
(setq diemBcuoi (list (car (last lisdau)) (cadr (last lisdau)) 0))
 
(setq tdi (tdiem (car lisdau) diemBcuoi))
(setq spt (/ (float (length lispobj)) 2) i spt)
;(if (= (rem i 1) 0) 
    (progn
(setq i (- i 0.5)) (setq j 0) 
(foreach x lisobj
(setq des (list (- (car tdi) (* i kc)) (cadr (nth j lisdau)) 0))
(vla-move x (vlax-3d-point (nth j lisdau)) (vlax-3d-point tdi))
(vla-move x (vlax-3d-point tdi) (vlax-3d-point des))
(setq i (1- i)) (setq j (1+ j))
 
       )
    )
 
(princ )
)
;
(defun tdiem(x y)
(list (/ (+ (car x) (car y)) 2) (/ (+ (cadr x) (cadr y)) 2) 0)
)
 

  • 0

#2 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 27 August 2013 - 03:26 PM

Đầu tiên nào thế bạn, đầu tiên theo thứ tự chọn lúc quét, hay đầu tiên theo trục X, trục Y. Nôm na là thế này.Nếu dùng các cách chọn sau để chọn đối tượng thì giải quyết thế nào

  1. Cách quét 1 : quét từ trái qua phải một lần hết luôn các Text cần xử lý, Enter vào giai đoạn lọc Text
  2. Cách quét 2: quét Text1 (không Enter)'   ----> quét Text3 (không Enter)'   ----> quét Text2 (không Enter)'   ---->...rất lộn xộn (mỗi lần quét một Text)
  3. Cách quét hỗn hợp hai cách trên có lần quét 2,3 Text có lần quét 1 Text sau đó mới Enter

  • 0

#3 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 27 August 2013 - 03:58 PM

Đầu tiên nào thế bạn, đầu tiên theo thứ tự chọn lúc quét, hay đầu tiên theo trục X, trục Y. Nôm na là thế này.Nếu dùng các cách chọn sau để chọn đối tượng thì giải quyết thế nào

  1. Cách quét 1 : quét từ trái qua phải một lần hết luôn các Text cần xử lý, Enter vào giai đoạn lọc Text
  2. Cách quét 2: quét Text1 (không Enter)'   ----> quét Text3 (không Enter)'   ----> quét Text2 (không Enter)'   ---->...rất lộn xộn (mỗi lần quét một Text)
  3. Cách quét hỗn hợp hai cách trên có lần quét 2,3 Text có lần quét 1 Text sau đó mới Enter

cám ơn bạn đã quan tâm ở đây chỉ quét 1 lần thôi ( trường hợp 1 bạn nêu)  bởi các text đó nó chồng lên nhau mà, mình đang tìm cách để sort theo phương x để xếp các nhóm chồng lên nhau làm thành 1 nhóm sau đó mới xử lý nhưng chưa xử lý được trường hợp lọc ở trên nên chưa làm tiếp. Bỡi có cả trăm trắc ngang mà phải quét từng trường hợp quá lâu.


  • 0

#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 27 August 2013 - 07:26 PM

cám ơn bạn đã quan tâm ở đây chỉ quét 1 lần thôi ( trường hợp 1 bạn nêu)  bởi các text đó nó chồng lên nhau mà, mình đang tìm cách để sort theo phương x để xếp các nhóm chồng lên nhau làm thành 1 nhóm sau đó mới xử lý nhưng chưa xử lý được trường hợp lọc ở trên nên chưa làm tiếp. Bỡi có cả trăm trắc ngang mà phải quét từng trường hợp quá lâu.

Hề hề hề,

Bạn chú ý rằng hàm (vl-sort ....) cho phép bạn loại bỏ các phần tử giống nhau trong một list bạn ạ. Vấn đề là ở chỗ bạn phải chọn đúng thuộc tính của đối tượng để tạo list mà thôi.


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

#5 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 28 August 2013 - 07:38 AM

Hề hề hề,

Bạn chú ý rằng hàm (vl-sort ....) cho phép bạn loại bỏ các phần tử giống nhau trong một list bạn ạ. Vấn đề là ở chỗ bạn phải chọn đúng thuộc tính của đối tượng để tạo list mà thôi.

Ở đây mình đang sử dụng lisp của bác Tue_VN mà dữ liệu đưa vào là 1 tập hợp chọn SS. Nên bây giờ mình muốn xử lý dữ liệu ngay trên tập hợp chọn đó. Bạn có thể đọc đoạn lisp trên sửa lại cho mình với


  • 0

#6 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 28 August 2013 - 09:06 AM

cám ơn bạn đã quan tâm ở đây chỉ quét 1 lần thôi ( trường hợp 1 bạn nêu)  bởi các text đó nó chồng lên nhau mà, mình đang tìm cách để sort theo phương x để xếp các nhóm chồng lên nhau làm thành 1 nhóm sau đó mới xử lý nhưng chưa xử lý được trường hợp lọc ở trên nên chưa làm tiếp. Bỡi có cả trăm trắc ngang mà phải quét từng trường hợp quá lâu.

101306_1.png

Nghĩa là nếu là như thể này thì khi quét một loạt Text rồi Enter thì chỉ nhận đuọc 2 Text cần xử lý là Text màu vàng và màu đỏ, các Text màu xanh thì XOÁ hết đi à bạn

Hay ý bạn là tại cùng một tọa độ X (tọa độ Y thì làm sao?, có cần tọa độ Z không) có rất nhiều Text trùng nhau: có Text thì giống nhau về giá trị, có Text thì khác nhau, sau đó xóa hết các Text trùng nhau, chỉ để lại một cái làm đại diện, các Text không bị trùng  thì để nguyên?

Bạn có thể upfile trong đó có mẫu đề bài, và Kết quả nếu lisp thực hiện được không


  • 0

#7 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 28 August 2013 - 09:20 AM

101306_1.png

Nghĩa là nếu là như thể này thì khi quét một loạt Text rồi Enter thì chỉ nhận đuọc 2 Text cần xử lý là Text màu vàng và màu đỏ, các Text màu xanh thì XOÁ hết đi à bạn

Hay ý bạn là tại cùng một tọa độ X (tọa độ Y thì làm sao?, có cần tọa độ Z không) có rất nhiều Text trùng nhau: có Text thì giống nhau về giá trị, có Text thì khác nhau, sau đó xóa hết các Text trùng nhau, chỉ để lại một cái làm đại diện, các Text không bị trùng  thì để nguyên?

Bạn có thể upfile trong đó có mẫu đề bài, và Kết quả nếu lisp thực hiện được không

ok ở đây các text chồng lên nhau chỉ cần lấy đại diện thôi

mình upfile lên để bạn hiểu hơn ở đây mình dùng lisp ở trên (lisp mình chưa sửa xóa đối tượng) nhưng vẫn thủ công là chọn từng nhóm chồng nhau

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

Lisp ở trên mình đã xử lý được các text trùng nhau về giá trị rồi nhưng đưa vào để xử lý sắp xếp thì bị lỗi 

do đó để làm được theo ý muốn thì mình phải chạy riêng lẻ 2 lisp

1. lisp XÓA 

2. lisp sắp xếp

Ý muốn bây giờ là Gộp lại 1 lisp 


  • 0

#8 quansla

quansla

    biết lệnh xclip

  • Members
  • PipPipPipPipPipPipPip
  • 643 Bài viết
Điểm đánh giá: 224 (khá)

Đã gửi 28 August 2013 - 09:36 AM

Bạn tham khảo nhé

http://www.cadviet.c...file_test_1.dwg
Trong này là điều kiện xắp xếp là
  ;Sap xep ss cu phap (vl-sort Tap_hop Dieu_kien_xap_xep
  ;Dieu kien xap xep, neu 2 toa do Y bang nhau thi xep theo X (X nao nho hon xep truoc)
  ; ;;;;;;;;;;;;;;;;, neu 2 toa do Y khac nhau thi khong can quan tam den X, cu Y nho hon thi xep truoc
Code (bạn copy dán vào Cad , quét chọn Text (trong file dwg kèm theo) và kiểm tra nhé. Nếu chưa ưng, suy nghĩ lại điều kiện kiểm tra, tự sửa theo ý mình hoặc cm để lại đây.



(progn
  ;Lay tap hop ss
  (setq ss (acet-ss-to-list (ssget '(( 0 . "TEXT,MTEXT")))))
  ;Sai so cho phep k
  (setq k 0.001)
  ;in ra Value cac Text bi chon truoc khi xap xep
  (princ "\nCac Text bi chon truoc khi xap xep\n")
  (princ)
  (defun InLst(lst / i)
    (foreach i lst
      (princ (cdr(assoc 1 (entget i))))
      (princ "\n")
      (princ)
      ))
  (InLst ss)
  ;Sap xep ss cu phap (vl-sort Tap_hop Dieu_kien_xap_xep
  ;Dieu kien xap xep, neu 2 toa do Y bang nhau thi xep theo X (X nao nho hon xep truoc)
  ; ;;;;;;;;;;;;;;;;, neu 2 toa do Y khac nhau thi khong can quan tam den X, cu Y nho hon thi xep truoc
  (setq ss2 (vl-sort ss
    '(lambda (e1 e2 / p10e1 p10e2)      ;khai bao ham chuyen dung de xu ly voi 2 doi tuong la e1 e2
(if (equal (cadr(setq p10e1 (cdr(assoc 10 (entget e1)))))
(cadr(setq p10e2 (cdr(assoc 10 (entget e2)))))
k)      ; dieu kien kiem tra neu co toa do Y1 = Y2 voi sai so k thi
 
 
 ;neu toa do Y bang nhau thi sap xep Text co X nho hon nen dau
 (< (car p10e1) (car p10e2))
 
 
 ;neu toa do Y khac nhau thi( ? ban chu noi ro) minh dat la chon Text co Y nho hon(o duoi)
 (< (cadr p10e1) (cadr p10e2))
 ))
    )
)
  (princ "\nCac Text sau khi xap xep\n")
  (princ)
  (InLst ss2)
  (princ)
  )


  • 1

#9 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 28 August 2013 - 09:58 AM

Bạn tham khảo nhé

http://www.cadviet.c...file_test_1.dwg
Trong này là điều kiện xắp xếp là
  ;Sap xep ss cu phap (vl-sort Tap_hop Dieu_kien_xap_xep
  ;Dieu kien xap xep, neu 2 toa do Y bang nhau thi xep theo X (X nao nho hon xep truoc)
  ; ;;;;;;;;;;;;;;;;, neu 2 toa do Y khac nhau thi khong can quan tam den X, cu Y nho hon thi xep truoc
Code (bạn copy dán vào Cad , quét chọn Text (trong file dwg kèm theo) và kiểm tra nhé. Nếu chưa ưng, suy nghĩ lại điều kiện kiểm tra, tự sửa theo ý mình hoặc cm để lại đây.



(progn
  ;Lay tap hop ss
  (setq ss (acet-ss-to-list (ssget '(( 0 . "TEXT,MTEXT")))))
  ;Sai so cho phep k
  (setq k 0.001)
  ;in ra Value cac Text bi chon truoc khi xap xep
  (princ "\nCac Text bi chon truoc khi xap xep\n")
  (princ)
  (defun InLst(lst / i)
    (foreach i lst
      (princ (cdr(assoc 1 (entget i))))
      (princ "\n")
      (princ)
      ))
  (InLst ss)
  ;Sap xep ss cu phap (vl-sort Tap_hop Dieu_kien_xap_xep
  ;Dieu kien xap xep, neu 2 toa do Y bang nhau thi xep theo X (X nao nho hon xep truoc)
  ; ;;;;;;;;;;;;;;;;, neu 2 toa do Y khac nhau thi khong can quan tam den X, cu Y nho hon thi xep truoc
  (setq ss2 (vl-sort ss
    '(lambda (e1 e2 / p10e1 p10e2)      ;khai bao ham chuyen dung de xu ly voi 2 doi tuong la e1 e2
(if (equal (cadr(setq p10e1 (cdr(assoc 10 (entget e1)))))
(cadr(setq p10e2 (cdr(assoc 10 (entget e2)))))
k)      ; dieu kien kiem tra neu co toa do Y1 = Y2 voi sai so k thi
 
 
 ;neu toa do Y bang nhau thi sap xep Text co X nho hon nen dau
 (< (car p10e1) (car p10e2))
 
 
 ;neu toa do Y khac nhau thi( ? ban chu noi ro) minh dat la chon Text co Y nho hon(o duoi)
 (< (cadr p10e1) (cadr p10e2))
 ))
    )
)
  (princ "\nCac Text sau khi xap xep\n")
  (princ)
  (InLst ss2)
  (princ)
  )

Ok cám ơn bạn

để mình kiểm tra xem


  • 0

#10 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 28 August 2013 - 03:11 PM

Ở đây mình đang sử dụng lisp của bác Tue_VN mà dữ liệu đưa vào là 1 tập hợp chọn SS. Nên bây giờ mình muốn xử lý dữ liệu ngay trên tập hợp chọn đó. Bạn có thể đọc đoạn lisp trên sửa lại cho mình với

Hề hề hề,

Đây là lisp xóa các text có nội dung trùng nhau trong một bộ chọn, chỉ để lại mỗi nhóm text giống nhau này một text đại diện duy nhất.

Bạn dùng thử và nếu Ok thì hãy tìm cách kết hợp với lisp mà bạn có.

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

Mình viết nháp, nếu thấy cần sửa chữa gì thêm thì post lên nhé.


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

#11 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 28 August 2013 - 03:55 PM

Bạn tham khảo nhé

http://www.cadviet.c...file_test_1.dwg
Trong này là điều kiện xắp xếp là
  ;Sap xep ss cu phap (vl-sort Tap_hop Dieu_kien_xap_xep
  ;Dieu kien xap xep, neu 2 toa do Y bang nhau thi xep theo X (X nao nho hon xep truoc)
  ; ;;;;;;;;;;;;;;;;, neu 2 toa do Y khac nhau thi khong can quan tam den X, cu Y nho hon thi xep truoc
Code (bạn copy dán vào Cad , quét chọn Text (trong file dwg kèm theo) và kiểm tra nhé. Nếu chưa ưng, suy nghĩ lại điều kiện kiểm tra, tự sửa theo ý mình hoặc cm để lại đây.



(progn
  ;Lay tap hop ss
  (setq ss (acet-ss-to-list (ssget '(( 0 . "TEXT,MTEXT")))))
  ;Sai so cho phep k
  (setq k 0.001)
  ;in ra Value cac Text bi chon truoc khi xap xep
  (princ "\nCac Text bi chon truoc khi xap xep\n")
  (princ)
  (defun InLst(lst / i)
    (foreach i lst
      (princ (cdr(assoc 1 (entget i))))
      (princ "\n")
      (princ)
      ))
  (InLst ss)
  ;Sap xep ss cu phap (vl-sort Tap_hop Dieu_kien_xap_xep
  ;Dieu kien xap xep, neu 2 toa do Y bang nhau thi xep theo X (X nao nho hon xep truoc)
  ; ;;;;;;;;;;;;;;;;, neu 2 toa do Y khac nhau thi khong can quan tam den X, cu Y nho hon thi xep truoc
  (setq ss2 (vl-sort ss
    '(lambda (e1 e2 / p10e1 p10e2)      ;khai bao ham chuyen dung de xu ly voi 2 doi tuong la e1 e2
(if (equal (cadr(setq p10e1 (cdr(assoc 10 (entget e1)))))
(cadr(setq p10e2 (cdr(assoc 10 (entget e2)))))
k)      ; dieu kien kiem tra neu co toa do Y1 = Y2 voi sai so k thi
 
 
 ;neu toa do Y bang nhau thi sap xep Text co X nho hon nen dau
 (< (car p10e1) (car p10e2))
 
 
 ;neu toa do Y khac nhau thi( ? ban chu noi ro) minh dat la chon Text co Y nho hon(o duoi)
 (< (cadr p10e1) (cadr p10e2))
 ))
    )
)
  (princ "\nCac Text sau khi xap xep\n")
  (princ)
  (InLst ss2)
  (princ)
  )

Vấn đề sort như vậy là ok rồi đúng ý mình rồi (cái này để mình gộp lại từng nhóm text chồng nhau)nhưng vấn đề của mình là làm sao để đưa vào tập hợp đã xử lý vào lisp sắp xếp các text ở trên 

như ở nói ở trên mình sử dung 2 lisp

1. Lisp xóa các text chồng nhau cùng giá trị 

2.Lisp sắp xếp lại text 

Bây giờ muốn gộp lai 1 lisp ++++> đang bị lỗi (lỗi ở đây theo mình hiểu do tập hợp chọn của mình sau khi xử lý không trả về được để xử lý tiếp theo)


  • 0

#12 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 28 August 2013 - 03:59 PM

Hề hề hề,

Đây là lisp xóa các text có nội dung trùng nhau trong một bộ chọn, chỉ để lại mỗi nhóm text giống nhau này một text đại diện duy nhất.

Bạn dùng thử và nếu Ok thì hãy tìm cách kết hợp với lisp mà bạn có.

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

Mình viết nháp, nếu thấy cần sửa chữa gì thêm thì post lên nhé.

Thấy ok rồi 

giờ thử gộp lại xem sao

Cám ơn bạn nhiều lắm


  • 0

#13 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 29 August 2013 - 09:28 AM

Thấy ok rồi 

giờ thử gộp lại xem sao

Cám ơn bạn nhiều lắm

Hề hề hề,

Bạn lưu ý khi gộp lisp rằng, với lisp của mình thì sau khi xóa các text có cùng nội dung tập ss sẽ trả về mo tức là chả còn phần tử nào đâu nhé.

Do vậy cái bước tiếp theo là sắp xếp ấy bạn cần có thao tác chọn lại tập ss.


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

#14 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 29 August 2013 - 10:25 AM

Hề hề hề,

Bạn lưu ý khi gộp lisp rằng, với lisp của mình thì sau khi xóa các text có cùng nội dung tập ss sẽ trả về mo tức là chả còn phần tử nào đâu nhé.

Do vậy cái bước tiếp theo là sắp xếp ấy bạn cần có thao tác chọn lại tập ss.

Đúng như bạn nói mình đang bí ở chổ đó làm sao không chọn lại tập ss mà nó xử lý luôn đang tìm nhiều cách nhưng chưa có cách nào nó trả lại tập ss đã loại trừ các text trung nhau để xử lý tiếp chứ chọn lại thì ko khác chi chạy 2 lisp độc lập. bạn có thể chỉ cách cho mình với chứ mình đã sử dụng hàm (ssadd) rồi nhưng cũng không được


  • 0

#15 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 29 August 2013 - 11:24 AM

Đúng như bạn nói mình đang bí ở chổ đó làm sao không chọn lại tập ss mà nó xử lý luôn đang tìm nhiều cách nhưng chưa có cách nào nó trả lại tập ss đã loại trừ các text trung nhau để xử lý tiếp chứ chọn lại thì ko khác chi chạy 2 lisp độc lập. bạn có thể chỉ cách cho mình với chứ mình đã sử dụng hàm (ssadd) rồi nhưng cũng không được

Hề hề hề,

Bạn hãy tạo một tập ss1 mới với các phần tử e được lấy đi khỏi tập ss qua mỗi bước trong vòng lặp (while ...)

Rồi bạn sử lý cái tập ss1 này là Ok đúng không???

Hãy dùng thử cái này coi sao , trong đó sau khi xóa hết các text trùng nội dung thì sẽ tạo ra được một tập ss1 mới gồm chỉ có các phần tử đại diện cho các nhóm text trùng nhau về nội dung từ tập ss ban đầu.

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


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

#16 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 29 August 2013 - 02:02 PM

Hề hề hề,

Bạn hãy tạo một tập ss1 mới với các phần tử e được lấy đi khỏi tập ss qua mỗi bước trong vòng lặp (while ...)

Rồi bạn sử lý cái tập ss1 này là Ok đúng không???

Hãy dùng thử cái này coi sao , trong đó sau khi xóa hết các text trùng nội dung thì sẽ tạo ra được một tập ss1 mới gồm chỉ có các phần tử đại diện cho các nhóm text trùng nhau về nội dung từ tập ss ban đầu.

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

hahahaha 

Đã làm được nhưng còn lỗi 1 tí nữa nếu tập hợp đó không bị xoá (không có đối tượng trùng nhau) thì chạy được, còn có đối tượng trùng nhau là bị lỗi mình tìm hiểu là do tập ss1 là tập đối tượng ban đầu, bây giờ mình phải đổi lại tập ss1 là tập còn lại, bạn chỉnh cho mình 1 tí nữa là ok

cám ơn bạn nhiều nhiều nhiều 


  • 0

#17 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 29 August 2013 - 02:57 PM

hahahaha 

Đã làm được nhưng còn lỗi 1 tí nữa nếu tập hợp đó không bị xoá (không có đối tượng trùng nhau) thì chạy được, còn có đối tượng trùng nhau là bị lỗi mình tìm hiểu là do tập ss1 là tập đối tượng ban đầu, bây giờ mình phải đổi lại tập ss1 là tập còn lại, bạn chỉnh cho mình 1 tí nữa là ok

cám ơn bạn nhiều nhiều nhiều 

Hề hề hề, 

Bạn đã sử dụng lisp mình mới bổ sung chưa???

Trong lisp này thì tập ss1 chính là tập các đối tượng còn lại từ tập ban đầu sau khi bị xóa đấy.


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

#18 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 29 August 2013 - 03:04 PM

Hề hề hề, 

Bạn đã sử dụng lisp mình mới bổ sung chưa???

Trong lisp này thì tập ss1 chính là tập các đối tượng còn lại từ tập ban đầu sau khi bị xóa đấy.

Mới download về theo đường dẫn của bạn nhưng mình sử dụng lisp cũ của bạn hôm qua rồi thêm dòng

(setq (ssadd ))

(setq ss1 (ssadd e ss1)


  • 0

#19 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 29 August 2013 - 08:42 PM

Hề hề hề, 

Bạn đã sử dụng lisp mình mới bổ sung chưa???

Trong lisp này thì tập ss1 chính là tập các đối tượng còn lại từ tập ban đầu sau khi bị xóa đấy.

Sau 1 hồi mày mò đủ cách mình đã làm được. 

Tập ss bạn chưa xóa các đối tượng trùng nhau (e1) nên tập ss1 vẫn là tập ban đầu

mình đã chỉnh sửa lại 1 tí là xóa các đối tượng trùng nhau trong tập ss nên bây giờ đã ok

lisp mình sửa lại

(setq ss (ssget '((0 . "*TEXT"))))
(setq ss1 (ssadd))
(while (setq e (ssname ss 0))
     (setq ssl (acet-ss-to-list ss) )
     (setq sslp (cdr ssl))
     (if (/= sslp nil)
         (foreach e1 sslp
            (if (= (cdr (assoc 1 (entget e1))) (cdr (assoc 1 (entget e))))
                                (progn
				(command "erase" e1 "")
				(setq ss (ssdel e1 ss)); Xóa đối tượng trùng ra khỏi tập hợp
				)
            )
         )
     )
     (setq ss1 (ssadd e ss1))
     (setq ss (ssdel e ss))
)

 

(while (setq e (ssname ss 0))
     (setq ssl (acet-ss-to-list ss) )
     (setq sslp (cdr ssl))
     (if (/= sslp nil)
         (foreach e1 sslp
            (if (= (cdr (assoc 1 (entget e1))) (cdr (assoc 1 (entget e))))
                (progn
(command "erase" e1 "")
(setq ss (ssdel e1 ss))
)
            )
         )
     )
     (setq ss1 (ssadd e ss1))
     (setq ss (ssdel e ss))
(while (setq e (ssname ss 0))
     (setq ssl (acet-ss-to-list ss) )
     (setq sslp (cdr ssl))
     (if (/= sslp nil)
         (foreach e1 sslp
            (if (= (cdr (assoc 1 (entget e1))) (cdr (assoc 1 (entget e))))
                (progn
(command "erase" e1 "")
(setq ss (ssdel e1 ss))
)
            )
         )
     )
     (setq ss1 (ssadd e ss1))
     (setq ss (ssdel e ss))

  • 0

#20 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 29 August 2013 - 08:47 PM

Mới download về theo đường dẫn của bạn nhưng mình sử dụng lisp cũ của bạn hôm qua rồi thêm dòng

(setq (ssadd ))

(setq ss1 (ssadd e ss1)

Hê hề hề, 

Chưa rõ bạn thêm thế nào nhưng mình đã chéck và tập ss1 đảm bảo là tập các text đại diện còn lại sau khi chạy lisp của mình...


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