Đế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

#121 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 21 October 2015 - 11:00 AM

Mấu chốt vấn đề ở đây là phân loại những thằng nào nằm ở cột 1, thằng nào nằm ở cột 2 (Khi quét 1 phát). Trên file của bạn, bạn thử move 1 thằng text theo chiều x đi 1 tý thì sẽ hiểu ngay vấn đề. Nếu trong hai cột mỗi cột đều có điểm chèn text giống nhau, thì cả 2 phương án sort ở trên đều OK. File của bạn ở cột 2 giá trị X điểm chèn của các text không bằng nhau.


  • 0

#122 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 20 September 2016 - 02:27 PM

Phải như thế này ko?



(defun c:at2t (/ center color data edata ent i sel ss str);All Text to Text

  (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)

	(vl-load-com)

	(foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

  	(vla-GetBoundingBox ent 'minpt 'maxpt)

  	(setq lst_min (cons (vlax-safearray->list minpt) lst_min)

 	lst_max (cons (vlax-safearray->list maxpt) lst_max)  )   )

	(setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))

 	(car (vl-sort (mapcar 'cadr lst_min) '<))  )

   ur (list (last (vl-sort (mapcar 'car lst_max) '<))

 	(last (vl-sort (mapcar 'cadr lst_max) '<)) ) )

	(mapcar '/ (mapcar '+ ll ur) '(2.0 2.0 2.0))	) 

  (defun Change_Str (data pt str color)

	(entmake (list (cons 0 "TEXT") (assoc 8 data) (cons 10 pt)

 	(cons 11 pt) (assoc 7 data) (assoc 40 data)

 	(cons 71 0) (cons 72 1) (cons 73 2)

 	(cons 1 str) (cons 62 color)

 	(if (assoc 6 data)  (assoc 6 data)  '(6 . "BYLAYER") )

 	(if (assoc 39 data) (assoc 39 data) '(39 . 0) )

 	(if (assoc 370 data) (assoc 370 data) '(370 . -1) ) ))  )

  (defun dxf (tag obj) (cdr (assoc tag obj)))

;main

  (setq ss (ssadd))

  (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))

	(setq ent (car sel))

	(if (= (cdr (assoc 0 (entget ent))) "TEXT")

  	(ssadd ent ss)) ) 

  (if (> (sslength ss) 0)

	(progn

  	(setq i -1

 	str ""

 	center (centerSS ss)    

 	data (entget (ssname ss 0))

 	color (dxf 62 data))

  	(while (setq ent (ssname ss (setq i (1+ i))))

(setq edata (entget ent)

   	str (strcat str " " (dxf 1 edata))  )

(entdel ent) )

  	(Change_Str data center (substr str 2) color) 	)

	(princ "\nKhong chon duoc Text !"))

  (princ))


 

E đang dùng lisp này của bác gia_bach. chạy rất ok, nhưng chỉ có hơi bất tiện ở chỗ: mỗi đợt nối 2 text (mỗi đợt nối text thì có mỗi yêu cầu khác nhau), cần thêm 1 cụm từ gì vào gữa 2 text cần nối thì e phải vào sửa code trong lisp. lúc thì nối không có khoảng trống, lúc thì nối cần có khoảng trống, lúc thì cần thêm cụm "-D" hoặc "-L=",... thì hơi mất công tý, mà e thì ko biết về lisp nên ko sửa cho trọn vẹn được ạ. nay e nhờ bác sửa cái lisp trên giúp e :

gõ n2t;

lisp sẽ nhắc: "thêm ký hiệu giữa 2 text" có thể là chữ, dấu, số,... nếu cần thêm gì thì gõ vào, ko cần thì thôi, ấn enter hoặc space (mặc định của lisp là nối text ko cần khoảng trắng. còn nếu cần nối text có khỏang trắng thì e sử dụng lại lisp ở trên.

chọn text theo thứ tự nối, ấn space, text được nối. chọn tiếp các text, ấn space, text được nối. ấn speace 2 lần để kết thúc lệnh (hoặc ấn esc để thoát lệnh mà cad ko bị lỗi :) ). mong bác gia_bach và mọi người giúp e ạ. e cảm ơn


  • 0

#123 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 22 September 2016 - 08:20 AM

E đang dùng lisp này của bác gia_bach. chạy rất ok, nhưng chỉ có hơi bất tiện ở chỗ: mỗi đợt nối 2 text (mỗi đợt nối text thì có mỗi yêu cầu khác nhau), cần thêm 1 cụm từ gì vào gữa 2 text cần nối thì e phải vào sửa code trong lisp. lúc thì nối không có khoảng trống, lúc thì nối cần có khoảng trống, lúc thì cần thêm cụm "-D" hoặc "-L=",... thì hơi mất công tý, mà e thì ko biết về lisp nên ko sửa cho trọn vẹn được ạ. nay e nhờ bác sửa cái lisp trên giúp e :

gõ n2t;

lisp sẽ nhắc: "thêm ký hiệu giữa 2 text" có thể là chữ, dấu, số,... nếu cần thêm gì thì gõ vào, ko cần thì thôi, ấn enter hoặc space (mặc định của lisp là nối text ko cần khoảng trắng. còn nếu cần nối text có khỏang trắng thì e sử dụng lại lisp ở trên.

chọn text theo thứ tự nối, ấn space, text được nối. chọn tiếp các text, ấn space, text được nối. ấn speace 2 lần để kết thúc lệnh (hoặc ấn esc để thoát lệnh mà cad ko bị lỗi :) ). mong bác gia_bach và mọi người giúp e ạ. e cảm ơn

Update theo yêu cầu:

 (defun c:at2t (/ center ent i sel ss str ans obj tobj dyn);All Text to Text
  (vl-load-com)
  (defun centerSS (ss / lst_max lst_min maxpt minpt ll ur)
    (foreach ent (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (vla-GetBoundingBox ent 'minpt 'maxpt)
      (setq lst_min (cons (vlax-safearray->list minpt) lst_min)
	    lst_max (cons (vlax-safearray->list maxpt) lst_max)  )   )
    (setq ll (list (car (vl-sort (mapcar 'car lst_min) '<))
		   (car (vl-sort (mapcar 'cadr lst_min) '<))  )
	  ur (list (last (vl-sort (mapcar 'car lst_max) '<))
		   (last (vl-sort (mapcar 'cadr lst_max) '<)) ) )
    (mapcar '/ (mapcar '+ ll ur) '(2.0 2.0 2.0))	) 
;main
  (setq ss (ssadd))
  (while (setq sel (entsel "\nChon cac Text can noi voi nhau: "))
    (setq ent (car sel))
    (if (= (cdr (assoc 0 (entget ent))) "TEXT")
      (ssadd ent ss)) )
  (if (> (sslength ss) 1)
    (progn
      (setq dyn (getvar "DYNMODE"))
      (setvar "DYNMODE" 0)
      (setq *connect (getstring t "\nKi hieu giua 2 text:"))
      (setvar "DYNMODE"  dyn)
      (setq i 0	    
	    center (centerSS ss)
	    obj (vlax-ename->vla-object (ssname ss 0))
	    str (vlax-get obj 'TextString) )
      (while (setq ent (ssname ss (setq i (1+ i))))
	(setq str (strcat str *connect (vlax-get (vlax-ename->vla-object ent) 'TextString)) )
	(entdel ent)	)
      (vla-put-alignment
	(setq tObj (vla-addText
		     (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object)))
		     str
		     (vlax-3d-point '(0 0 0)) 1)) acAlignmentMiddleCenter)
      (vla-put-TextAlignmentPoint tObj (vlax-3d-point center))
      (foreach pro (list "Height" "Layer" "Linetype" "Rotation" "Color")
	(vlax-put tObj pro (vlax-get obj pro)))
      (vla-erase obj)      )
    (princ "\nKhong chon duoc Text !"))
  (princ))

  • 1

#124 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 22 September 2016 - 12:29 PM

em đã thử lisp bác gửi, kết quả vượt mức sự mong đợi ạ. cảm ơn bác rất nhiều. 


  • 0