Đến nội dung


Hình ảnh
- - - - -

Lisp Ghép Text Cần Giúp Đỡ


  • Please log in to reply
123 replies to this topic

#101 sukhoi47

sukhoi47

    biết pan

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

Đã gửi 15 July 2015 - 08:27 AM

Bạn anti lazy nên thông cảm, vì đa phần các yêu cầu là từ những người không biết gì về lisp. Chắc bạn ấy cũng vậy (?)

Trường hợp biết mà ỷ lại và khoái nhờ vả hơn lao động thì thật đáng trách.

 

 cảm ơn bác Doan van Ha rât nhiều, em không biết gì về lisp cả, nên không biết sửa như thế nào. bác hướng dẩn như trên em làm theo và được rồi, đa tạ bác.


  • 0

#102 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 16 October 2015 - 11:25 AM

Các bác giúp em ca này với. bản vẽ sau khi em đã sử dụng lisp exa của 1 bác trên diễn đàn. xuất dữ liệu bản vẽ  ra bảng rồi . sau khi em explode và em muốn nối 2 cột text thành 1 cột và text của 2 cột gộp với nhau ở giữa có dấu – được không ? http://www.cadviet.c.../146910_mau.dwg


  • -1

#103 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 16 October 2015 - 02:16 PM

Các bác giúp em ca này với. bản vẽ sau khi em đã sử dụng lisp exa của 1 bác trên diễn đàn. xuất dữ liệu bản vẽ  ra bảng rồi . sau khi em explode và em muốn nối 2 cột text thành 1 cột và text của 2 cột gộp với nhau ở giữa có dấu – được không ? http://www.cadviet.c.../146910_mau.dwg

Hề hề hề,

Quả là "không hề đơn giản" .....

Gửi một bản vẽ có cái bảng mà chả hiểu cần phải làm gì nữa. Ghép chàng nào với cô nào, cho ở chung tập thể hay mỗi cặp một buồng??? Thật là "không hề đơn giản" bác chủ thớt ạ.


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

#104 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 16 October 2015 - 05:43 PM

Hề hề hề,

Quả là "không hề đơn giản" .....

Gửi một bản vẽ có cái bảng mà chả hiểu cần phải làm gì nữa. Ghép chàng nào với cô nào, cho ở chung tập thể hay mỗi cặp một buồng??? Thật là "không hề đơn giản" bác chủ thớt ạ.

 

Mục đích của em là xin lisp để nối text trong 2 cột thành 1 cột và ở giữa có dấu – như trong bản vẽ dưới đây ạhttp://www.cadviet.c...46910_mau_1.dwg


  • -1

#105 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 17 October 2015 - 01:35 PM

Mục đích của em là xin lisp để nối text trong 2 cột thành 1 cột và ở giữa có dấu – như trong bản vẽ dưới đây ạhttp://www.cadviet.c...46910_mau_1.dwg

Hề hề hề,

Vậy là bạn muốn cho các cập đôi này sống chung trong một chuồng . Vậy thì thử cái này coi sao.

 

http://www.cadviet.c...194_ghepcot.lsp

 

(defun c:ghct (/ p p1 p2 h ht r1 r2 ls1 ls2 ls3 ss txt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n Chon diem goc tren ben trai cot 1")
          p2 (getpoint "\n Chon diem goc trên ben trai cot 2")
          h (getdist p2 "\n Chon diem xac dinh chieu cao hang cua bang")
          r1 (getdist p1 "\n Chon diem xac dinh chieu rong cot 1")
          r2 (getdist p2 "\n Chon diem xac dinh chieu rong cot 2")
          ls1 (list)
          ls2 (list)
          ls3 (list)  )
(while (setq ss (ssget "f" (list p1 (list (+ (car p1) r1) (- (cadr p1) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls1 (append ls1 (list txt))
                   p1 (list (car p1) (- (cadr p1) h)) 
                   ht (cdr (assoc 40 (entget (ssname ss 0)))) )
)
(while (setq ss (ssget "f" (list p2 (list (+ (car p2) r2) (- (cadr p2) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls2 (append ls2 (list txt))
                   p2 (list (car p2) (- (cadr p2) h))  )
)   
(if (= (length ls1) (length ls2))
    (setq ls3 (mapcar '(lambda (x y) (strcat  x "-" y)) ls1 ls2))
)
(if ls3
    (command "rectangle" (setq p1 (getpoint "\n Chon diem dat bang moi")) (list (+ (car p1) r1 r2) (- (cadr p1) (* h (length ls3))))  )
)
(foreach txt ls3
    (setq p (list (+ (car p1) (/ (+ r1 r2) 2)) (- (cadr p1) (/ h 2))))
    (command "text" "j" "mc" p ht 0 txt)
    (setq p1 (list (car p1) (- (cadr p1) h)))
)
(setvar "osmode" oldos)
(princ)
)    

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

#106 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 17 October 2015 - 01:52 PM

 

Hề hề hề,

Vậy là bạn muốn cho các cập đôi này sống chung trong một chuồng . Vậy thì thử cái này coi sao.

 

http://www.cadviet.c...194_ghepcot.lsp

(defun c:ghct (/ p p1 p2 h ht r1 r2 ls1 ls2 ls3 ss txt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n Chon diem goc tren ben trai cot 1")
          p2 (getpoint "\n Chon diem goc trên ben trai cot 2")
          h (getdist p2 "\n Chon diem xac dinh chieu cao hang cua bang")
          r1 (getdist p1 "\n Chon diem xac dinh chieu rong cot 1")
          r2 (getdist p2 "\n Chon diem xac dinh chieu rong cot 2")
          ls1 (list)
          ls2 (list)
          ls3 (list)  )
(while (setq ss (ssget "f" (list p1 (list (+ (car p1) r1) (- (cadr p1) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls1 (append ls1 (list txt))
                   p1 (list (car p1) (- (cadr p1) h)) 
                   ht (cdr (assoc 40 (entget (ssname ss 0)))) )
)
(while (setq ss (ssget "f" (list p2 (list (+ (car p2) r2) (- (cadr p2) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls2 (append ls2 (list txt))
                   p2 (list (car p2) (- (cadr p2) h))  )
)   
(if (= (length ls1) (length ls2))
    (setq ls3 (mapcar '(lambda (x y) (strcat  x "-" y)) ls1 ls2))
)
(if ls3
    (command "rectangle" (setq p1 (getpoint "\n Chon diem dat bang moi")) (list (+ (car p1) r1 r2) (- (cadr p1) (* h (length ls3))))  )
)
(foreach txt ls3
    (setq p (list (+ (car p1) (/ (+ r1 r2) 2)) (- (cadr p1) (/ h 2))))
    (command "text" "j" "mc" p ht 0 txt)
    (setq p1 (list (car p1) (- (cadr p1) h)))
)
(setvar "osmode" oldos)
(princ)
)    

em load syntax error bác ạ


  • 0

#107 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 17 October 2015 - 02:46 PM

 

 

Hề hề hề,

Vậy là bạn muốn cho các cập đôi này sống chung trong một chuồng . Vậy thì thử cái này coi sao.

 

http://www.cadviet.c...194_ghepcot.lsp

(defun c:ghct (/ p p1 p2 h ht r1 r2 ls1 ls2 ls3 ss txt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\n Chon diem goc tren ben trai cot 1")
          p2 (getpoint "\n Chon diem goc trên ben trai cot 2")
          h (getdist p2 "\n Chon diem xac dinh chieu cao hang cua bang")
          r1 (getdist p1 "\n Chon diem xac dinh chieu rong cot 1")
          r2 (getdist p2 "\n Chon diem xac dinh chieu rong cot 2")
          ls1 (list)
          ls2 (list)
          ls3 (list)  )
(while (setq ss (ssget "f" (list p1 (list (+ (car p1) r1) (- (cadr p1) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls1 (append ls1 (list txt))
                   p1 (list (car p1) (- (cadr p1) h)) 
                   ht (cdr (assoc 40 (entget (ssname ss 0)))) )
)
(while (setq ss (ssget "f" (list p2 (list (+ (car p2) r2) (- (cadr p2) h))) (list (cons 0 "*text")) ))
         (setq txt (cdr (assoc 1 (entget (ssname ss 0))))
                   ls2 (append ls2 (list txt))
                   p2 (list (car p2) (- (cadr p2) h))  )
)   
(if (= (length ls1) (length ls2))
    (setq ls3 (mapcar '(lambda (x y) (strcat  x "-" y)) ls1 ls2))
)
(if ls3
    (command "rectangle" (setq p1 (getpoint "\n Chon diem dat bang moi")) (list (+ (car p1) r1 r2) (- (cadr p1) (* h (length ls3))))  )
)
(foreach txt ls3
    (setq p (list (+ (car p1) (/ (+ r1 r2) 2)) (- (cadr p1) (/ h 2))))
    (command "text" "j" "mc" p ht 0 txt)
    (setq p1 (list (car p1) (- (cadr p1) h)))
)
(setvar "osmode" oldos)
(princ)
)    

em load syntax error bác ạ

 

Hề hề hề,

 Bạn nên download file theo dường dẫn mình gửi, đừng download từ code box bởi hình như code box của diễn đàn có lỗi. Lisp mình đã test Ok rồi mới post.


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

#108 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 17 October 2015 - 03:44 PM

Hề hề hề,

 Bạn nên download file theo dường dẫn mình gửi, đừng download từ code box bởi hình như code box của diễn đàn có lỗi. Lisp mình đã test Ok rồi mới post.

Em lại làm phiền bác chút.lísp chạy đôi lúc không hiện bước cuối là : điểm để xuất ra bảng và do đó ko hiện bảng .Giờ em ko quan tâm cái bảng đó nữa. em copy 2 cột text đó ra  bác sửa cái lísp  sao cho em quét chuột 1 cái mà 2 cột tự ghép lại được không và ở giữa các text có dấu ''-'' ạ ? và đối tượng dtext và mtext đều được ạ. 


  • -1

#109 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 17 October 2015 - 03:51 PM

Em lại làm phiền bác chút.lísp chạy đôi lúc không hiện bước cuối là : điểm để xuất ra bảng và do đó ko hiện bảng .Giờ em ko quan tâm cái bảng đó nữa. em copy 2 cột text đó ra  bác sửa cái lísp  sao cho em quét chuột 1 cái mà 2 cột tự ghép lại được không và ở giữa các text có dấu ''-'' ạ ? và đối tượng dtext và mtext đều được ạ. 

Hề hề hề,

1/-Sở dĩ lisp không chạy ra bảng có thể do số lượng các text trong mỗi cột không bằng nhau. 

2/- Không hiểu điều bạn muốn.


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

#110 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 17 October 2015 - 04:10 PM

Hề hề hề,

1/-Sở dĩ lisp không chạy ra bảng có thể do số lượng các text trong mỗi cột không bằng nhau. 

2/- Không hiểu điều bạn muốn.

ý em là để cho đơn giản vấn đề thì em có 2 cột dtext(mtext ) như sau:

1a   b3

2n   1-r

sd    3

lsd   1-r

...     ....

bác có thể giúp em sao cho khi đánh lệnh rồi chọn quét tất cả sẽ tạo ra :

1a-b3

2n-1-r

sd-3

lsd-1r

....


  • 0

#111 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 17 October 2015 - 04:52 PM

ý em là để cho đơn giản vấn đề thì em có 2 cột dtext(mtext ) như sau:

1a   b3

2n   1-r

sd    3

lsd   1-r

...     ....

bác có thể giúp em sao cho khi đánh lệnh rồi chọn quét tất cả sẽ tạo ra :

1a-b3

2n-1-r

sd-3

lsd-1r

....

 

Bạn thử lisp này

(defun c:gct (/ ss1 ss2 _NHT:sssortXY)
  ;;sap xep cac toi tuong theo X hoac Y
;;ss - selection by ssget
;;dir: T - sap xep theo X tang dan
;;     nil - sap xep theo Y giam dan
;;vla: T/nil
;;return OBJECT/ENAME

(defun _NHT:sssortXY (ss dir vla / lstent)
  ;(setq ss(ssget))
  (if ss
    (progn
    (setq lstent
	   (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		    (if	dir
		      
		      '(lambda (x y)
			 
			 (< (car (cdr (assoc 10 (entget x))))
			    (car (cdr (assoc 10 (entget y))))
			 )
		       )
		      
		      '(lambda (x y)
			 (> (cadr (cdr (assoc 10 (entget x))))
			    (cadr (cdr (assoc 10 (entget y))))
			 )
		       )
		    )
	   )
    )
    (if vla (setq lstent(mapcar 'vlax-ename->vla-object lstent)) lstent)
    )
    lstent
  )
)
  (command "_.undo" "be")
  (if (and
	(princ "\nChon cac text o cot 1")
	(setq ss1 (ssget '((0 . "text, mtext"))))
	(princ "\nChon cac text o cot 2")
	(setq ss2 (ssget '((0 . "text, mtext"))))
      )
    (mapcar
      '(lambda (x y)
	 (vla-put-textstring
	   x
	   (strcat (vla-get-textstring x) "-" (vla-get-textstring y))
	 )
       )
      (_NHT:sssortXY ss1 nil t)
      (_NHT:sssortXY ss2 nil t)
    )
  )
  (command "_.undo" "e")
  (princ)
  )

  • 0

#112 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 17 October 2015 - 05:43 PM

Một cách viết khác, quét 1 phát ( với điều kiện các text trong mỗi cột tương đối ngăn nắp 1 tý ):

(defun c:test (/ ss ent hei lst ls1 ls2 i lse)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn (repeat (setq i (sslength ss))
(setq ent (ssname ss (setq i (1- i)))
hei (cdr (assoc 40 (entget ent)))
lst (cons (cons (cdr (assoc 10 (entget ent))) (cdr (assoc 1 (entget ent)))) lst)
lst (vl-sort lst '(lambda (x y) (< (car (car x)) (car (car y)))))))
(foreach x lst
(if (equal (caar x) (caaar lst) (* 0.1 hei))
(setq ls1 (cons (cdr x) ls1))
(setq ls2 (cons (cdr x) ls2))))
(setq lst (mapcar '(lambda (x y) (strcat x "-" y)) ls1 ls2))
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(if (member (cdr (assoc 1 (entget ent))) ls2)
(entdel ent)
(setq lse (cons ent lse))))
(mapcar '(lambda (x y) (vla-put-textstring (vlax-ename->vla-object x) y)) lse lst)))
(princ))

  • 1

#113 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 19 October 2015 - 09:08 AM

 

Bạn thử lisp này

(defun c:gct (/ ss1 ss2 _NHT:sssortXY)
  ;;sap xep cac toi tuong theo X hoac Y
;;ss - selection by ssget
;;dir: T - sap xep theo X tang dan
;;     nil - sap xep theo Y giam dan
;;vla: T/nil
;;return OBJECT/ENAME

(defun _NHT:sssortXY (ss dir vla / lstent)
  ;(setq ss(ssget))
  (if ss
    (progn
    (setq lstent
	   (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
		    (if	dir
		      
		      '(lambda (x y)
			 
			 (< (car (cdr (assoc 10 (entget x))))
			    (car (cdr (assoc 10 (entget y))))
			 )
		       )
		      
		      '(lambda (x y)
			 (> (cadr (cdr (assoc 10 (entget x))))
			    (cadr (cdr (assoc 10 (entget y))))
			 )
		       )
		    )
	   )
    )
    (if vla (setq lstent(mapcar 'vlax-ename->vla-object lstent)) lstent)
    )
    lstent
  )
)
  (command "_.undo" "be")
  (if (and
	(princ "\nChon cac text o cot 1")
	(setq ss1 (ssget '((0 . "text, mtext"))))
	(princ "\nChon cac text o cot 2")
	(setq ss2 (ssget '((0 . "text, mtext"))))
      )
    (mapcar
      '(lambda (x y)
	 (vla-put-textstring
	   x
	   (strcat (vla-get-textstring x) "-" (vla-get-textstring y))
	 )
       )
      (_NHT:sssortXY ss1 nil t)
      (_NHT:sssortXY ss2 nil t)
    )
  )
  (command "_.undo" "e")
  (princ)
  )

Lisp bác viết chạy rất ổn. Em cảm ơn các bác đã nhiệt tình giúp đỡ em ạ 


  • 0

#114 nhoclangbac

nhoclangbac

    biết vẽ circle

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

Đã gửi 20 October 2015 - 09:07 PM

Nhoc Test Code Anh quocmanh04tt sao quơ 1 phát thì thấy râu ông nọ cắm cằm bà kia là sao ta ...
  • 0

#115 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 20 October 2015 - 09:21 PM

Nhoc biết code mà ( ở trên có ghi chú đó thôi ) - Trong code có phân loại giá trị x - dxf 10 của mỗi cột text -> nên mới có ghi chú là "Ngăn Nắp".


  • 0

#116 nhoclangbac

nhoclangbac

    biết vẽ circle

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

Đã gửi 20 October 2015 - 09:27 PM

Thì Nhoc lấy bản vẽ của chủ thót Test... 2 thằng đầu ok, 2 thằng cúi thì lộn tùng phèo ... Chắc Sort có vấn đề
  • 0

#117 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 20 October 2015 - 09:33 PM

Cái đó do cột thứ 2 dxf 10 không cùng x.


  • 0

#118 nhoclangbac

nhoclangbac

    biết vẽ circle

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

Đã gửi 20 October 2015 - 09:44 PM

Ah ah, Nhoc thix nhanh gọn quơ 1 phát ... Vậy có lẻ chơi Sort theo y là Ok Ps : sao mạng gởi bài khổ quá !!!

(defun c:test (/ ss ent hei lst ls1 ls2 i lse)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
 (progn
    (repeat (setq i (sslength ss))
             (setq ent (ssname ss (setq i (1- i)))
                      hei (cdr (assoc 40 (entget ent)))
                      lst (cons (cons (cdr (assoc 10 (entget ent))) (cdr (assoc 1 (entget ent)))) lst)
                      lst (vl-sort lst '(lambda (x y) (< (cadr (car x)) (cadr (car y)))))
             )
    )
    (foreach x lst
           (if (equal (caar x) (caar (last lst)) (* 0.1 hei))
               (setq ls1 (cons (cdr x) ls1))
               (setq ls2 (cons (cdr x) ls2))
           )
    )
    (setq lst (mapcar '(lambda (x y) (strcat x "-" y)) ls1 ls2))
    (setq i -1)
    (while (setq ent (ssname ss (setq i (1+ i))))
           (if (member (cdr (assoc 1 (entget ent))) ls2)
               (entdel ent)
               (setq lse (cons ent lse))
           )
    )
    (mapcar '(lambda (x y) (vla-put-textstring (vlax-ename->vla-object x) y)) lse lst)
  )
)
(princ)
)

  • 0

#119 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 20 October 2015 - 09:51 PM

OK

P/s: Nếu cột 1 có x khác nhau thì lại có vấn đề ...


  • 0

#120 Khonghedongian

Khonghedongian

    biết vẽ circle

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

Đã gửi 21 October 2015 - 09:58 AM

mình thấy lisp của Nhoc rất ổn đấy chứ.


  • 0