Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
AUTOCAD_2019

Nhờ các anh viết giúp lisp

Bởi AUTOCAD_2019 , trong AutoLisp

Các bài được khuyến nghị

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
11 phút trước, AUTOCAD_2019 đã nói:

Em có file text, các text bị gộp chung mã \p giờ em muốn tách những thông số ra thành từng layer như sau, hoặc tách thành từng dòng riêng biệt ...

image.png.a3de151bbc74bb006f7ee0ad66c66b55.png

 

em gửi file ạ

17-07-2019.dwg

Vấn đề này tôi thấy bạn hỏi rất nhiều lần rồi

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

AUTOCAD_2019    7

AUTOCAD_2019
Đã đăng
8 phút trước, Doan Nguyen Van đã nói:

Vấn đề này tôi thấy bạn hỏi rất nhiều lần rồi

đợt trước là text không bị gộp nên em có thể sử dung lisp lọc layer còn trường hợp này mà các text bị gộp thành mtext nên không lọc được

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
4 phút trước, AUTOCAD_2019 đã nói:

đợt trước là text không bị gộp nên em có thể sử dung lisp lọc layer còn trường hợp này mà các text bị gộp thành mtext nên không lọc được

Bạn có thể đăng bài này trong topic đó. Để có ai muốn giúp thì có thể sử dụng luôn lisp có sẵn trong bài để sửa, hoặc hình dung được luôn vấn đề bạn muốn hỏi.

Mở nhiều topic như này khó tiếp cận người muốn giúp...

  • Like 2

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
4 giờ trước, AUTOCAD_2019 đã nói:

em hiểu ý anh r để lần sau em sẽ làm vậy ạ 

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str)
  (vl-load-com)
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "MTEXT")))))
  (setvar 'cmdecho 0)
    (setq lstl (list "layer1" "layer2" "layer3" "layer4" "layer5"))
  (mapcar '(lambda (x)(if (not (tblsearch "layer" x)) (command "-LAYER" "M" x "" "")) ) lstl)
  (foreach ent ss
    (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    (setq ss1 (acet-ss-to-list (acet-explode ent)))
    (setq ss1 (vl-sort ss1 '(lambda (x y) (cond	( (= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))) )
					    (< (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y))))))
					     ((> (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget  y))))))  ))))
    (setq lst (list))
    (while (setq en (car ss1))
      (setq ss1 (cdr ss1))
      (setq lst2 (list en))
      (while (and (setq en2 (car ss1))
		  (= (cadr (cdr (assoc 10 (entget en)))) (cadr (cdr (assoc 10 (entget en2)))) ) )
	(setq ss1 (cdr ss1))
	(setq lst2 (append lst2 (list en2)))
	)
      (if (> (length lst2) 1) (progn
	(setq str "")
	(mapcar '(lambda (x) (setq str (strcat str (cdr (assoc 1 (entget x)))))) lst2)
	(setq en3 (car lst2))
	 (mapcar '(lambda (x) (entdel x) ) (cdr lst2))
	(entmod (subst (cons 1 str) (assoc 1 (entget en3)) (entget en3)))
	(setq lst (append lst (list en3)))
	) (setq lst (append lst lst2)))
      )
    (if (= (length lst) 5) (progn
			     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
			     (mapcar '(lambda (x y) (vla-put-layer (vlax-ename->vla-object x) y)) lst lstl))
      (progn
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(command "UNDO" "1")))
    )
  (setvar 'cmdecho 1)
  (princ)
  )

Viết cho bạn luôn đây 

  • Like 3

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

AUTOCAD_2019    7

AUTOCAD_2019
Đã đăng
Vào lúc 17/7/2019 tại 15:25, Doan Nguyen Van đã nói: 

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str)
  (vl-load-com)
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "MTEXT")))))
  (setvar 'cmdecho 0)
    (setq lstl (list "layer1" "layer2" "layer3" "layer4" "layer5"))
  (mapcar '(lambda (x)(if (not (tblsearch "layer" x)) (command "-LAYER" "M" x "" "")) ) lstl)
  (foreach ent ss
    (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    (setq ss1 (acet-ss-to-list (acet-explode ent)))
    (setq ss1 (vl-sort ss1 '(lambda (x y) (cond	( (= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))) )
					    (< (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y))))))
					     ((> (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget  y))))))  ))))
    (setq lst (list))
    (while (setq en (car ss1))
      (setq ss1 (cdr ss1))
      (setq lst2 (list en))
      (while (and (setq en2 (car ss1))
		  (= (cadr (cdr (assoc 10 (entget en)))) (cadr (cdr (assoc 10 (entget en2)))) ) )
	(setq ss1 (cdr ss1))
	(setq lst2 (append lst2 (list en2)))
	)
      (if (> (length lst2) 1) (progn
	(setq str "")
	(mapcar '(lambda (x) (setq str (strcat str (cdr (assoc 1 (entget x)))))) lst2)
	(setq en3 (car lst2))
	 (mapcar '(lambda (x) (entdel x) ) (cdr lst2))
	(entmod (subst (cons 1 str) (assoc 1 (entget en3)) (entget en3)))
	(setq lst (append lst (list en3)))
	) (setq lst (append lst lst2)))
      )
    (if (= (length lst) 5) (progn
			     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
			     (mapcar '(lambda (x y) (vla-put-layer (vlax-ename->vla-object x) y)) lst lstl))
      (progn
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(command "UNDO" "1")))
    )
  (setvar 'cmdecho 1)
  (princ)
  )

Viết cho bạn luôn đây 

anh có thể chỉ giúp em thêm dòng lệnh để tăng tốc độ xử lí không anh vì đối tượng nó hơi nhiêu nên xử lí hơi bị lâu ạ

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

divine kai    0

divine kai
Đã đăng
Vào lúc 17/7/2019 tại 15:25, Doan Nguyen Van đã nói: 

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str)
  (vl-load-com)
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "MTEXT")))))
  (setvar 'cmdecho 0)
    (setq lstl (list "layer1" "layer2" "layer3" "layer4" "layer5"))
  (mapcar '(lambda (x)(if (not (tblsearch "layer" x)) (command "-LAYER" "M" x "" "")) ) lstl)
  (foreach ent ss
    (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    (setq ss1 (acet-ss-to-list (acet-explode ent)))
    (setq ss1 (vl-sort ss1 '(lambda (x y) (cond	( (= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))) )
					    (< (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y))))))
					     ((> (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget  y))))))  ))))
    (setq lst (list))
    (while (setq en (car ss1))
      (setq ss1 (cdr ss1))
      (setq lst2 (list en))
      (while (and (setq en2 (car ss1))
		  (= (cadr (cdr (assoc 10 (entget en)))) (cadr (cdr (assoc 10 (entget en2)))) ) )
	(setq ss1 (cdr ss1))
	(setq lst2 (append lst2 (list en2)))
	)
      (if (> (length lst2) 1) (progn
	(setq str "")
	(mapcar '(lambda (x) (setq str (strcat str (cdr (assoc 1 (entget x)))))) lst2)
	(setq en3 (car lst2))
	 (mapcar '(lambda (x) (entdel x) ) (cdr lst2))
	(entmod (subst (cons 1 str) (assoc 1 (entget en3)) (entget en3)))
	(setq lst (append lst (list en3)))
	) (setq lst (append lst lst2)))
      )
    (if (= (length lst) 5) (progn
			     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
			     (mapcar '(lambda (x y) (vla-put-layer (vlax-ename->vla-object x) y)) lst lstl))
      (progn
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(command "UNDO" "1")))
    )
  (setvar 'cmdecho 1)
  (princ)
  )

Anh ơi hiện tại dữ liệu của em cũng gần giống bạn này nhưng chỉ có 4 dòng, anh có thể giúp em sửa lại lisp trên thành 4 được không anh, em cảm ơn anh nhiều...

em gửi dứ liệu ạ

 

du lieu.dwg

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
11 phút trước, divine kai đã nói:

Anh ơi hiện tại dữ liệu của em cũng gần giống bạn này nhưng chỉ có 4 dòng, anh có thể giúp em sửa lại lisp trên thành 4 được không anh, em cảm ơn anh nhiều...

em gửi dứ liệu ạ

 

du lieu.dwg

Bạn xóa chữ Layer 5 đi, rồi đoạn này sửa số 5 thành 4

(if (= (length lst) 5) (progn

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
22 phút trước, divine kai đã nói:

cho em hỏi là nếu trường hợp là 3 dòng thì mình lại bỏ chữ layer 4 và sửa thành số 3 đúng không anh

Bạn cứ thử là biết mà ^^ 

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

divine kai    0

divine kai
Đã đăng
Vào lúc 6/9/2019 tại 09:23, Doan Nguyen Van đã nói:

 

Anh ơi anh có thể thêm vào dòng lệnh tăng tốc xử lí lên được không anh, của em có đen 300 ngàn đối tượng em đã quét một lần 500 đối tượng nhưng lisp vẫn xử lí rất lâu và mất nhiều thời gian, anh có thể thêm giúp em không anh?

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
5 phút trước, divine kai đã nói:

Anh ơi anh có thể thêm vào dòng lệnh tăng tốc xử lí lên được không anh, của em có đen 300 ngàn đối tượng em đã quét một lần 500 đối tượng nhưng lisp vẫn xử lí rất lâu và mất nhiều thời gian, anh có thể thêm giúp em không anh?

Bản vẽ của bạn đâu ???

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
54 phút trước, divine kai đã nói:

do dữ liệu chỉ cho 1.95m nên em gọt bớt file lại

du lieu 2.dwg 

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str)
  (vl-load-com)
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "MTEXT")))))
  (setvar 'cmdecho 0)
    (setq lstl (list "layer1" "layer2" "layer3" "layer4" "layer5"))
  (setq i 0)
  (mapcar '(lambda (x)(if (not (tblsearch "layer" x)) (progn (setq i (1+ i)) (command "-LAYER" "M" x "C" (itoa i) "" ""))) ) lstl)
  (foreach ent ss
    (setq lst (list))
    (setq str (cdr (assoc 1 (entget ent)))) 
    (while (vl-string-search "\\P" str)
      (setq stri (substr str 1 (vl-string-search "\\P" str)))
      (if (/= stri "")
      (setq lst (append lst (list stri))) )
      (setq str (substr str (+ (vl-string-search "\\P" str) 3)))
      )
    (if (/= str "") (setq lst (append lst (list str))))
    
    (if (= (length lst) 5 ) (progn
			    (setq pt (cdr (assoc 10 (entget ent))))
	(mapcar '(lambda (str lay) (maketext pt str (cdr (assoc 40 (entget ent))) lay (cdr (assoc 7 (Entget ent)))
					  (vla-get-linespacingfactor (vlax-ename->vla-object ent))   )
		   (setq pt (polar pt (* 1.5 pi) (vla-get-linespacingdistance (vlax-ename->vla-object ent) )) ) ) lst lstl)
			    (entdel ent)
			     ) 
      )
    )
  (setvar 'cmdecho 1)
  (princ)
  )
(defun maketext (point noidungtext heighttext lay style sps / oldla)
  (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
              (cons 10 point)
              (cons 40 heighttext)
              (cons 1 noidungtext)
		  (cons 8 lay)
		  (cons 7 style)
		  (cons 44 sps)
		(cons 71 2)
		 (cons 72 1)
		  (cons 73 2)
		  ))
  )

Đã sửa cho bạn đây, nhanh đáng kể 

  • Like 1

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

divine kai    0

divine kai
Đã đăng
42 phút trước, Doan Nguyen Van đã nói: 

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str)
  (vl-load-com)
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "MTEXT")))))
  (setvar 'cmdecho 0)
    (setq lstl (list "layer1" "layer2" "layer3" "layer4" "layer5"))
  (setq i 0)
  (mapcar '(lambda (x)(if (not (tblsearch "layer" x)) (progn (setq i (1+ i)) (command "-LAYER" "M" x "C" (itoa i) "" ""))) ) lstl)
  (foreach ent ss
    (setq lst (list))
    (setq str (cdr (assoc 1 (entget ent)))) 
    (while (vl-string-search "\\P" str)
      (setq stri (substr str 1 (vl-string-search "\\P" str)))
      (if (/= stri "")
      (setq lst (append lst (list stri))) )
      (setq str (substr str (+ (vl-string-search "\\P" str) 3)))
      )
    (if (/= str "") (setq lst (append lst (list str))))
    
    (if (= (length lst) 5 ) (progn
			    (setq pt (cdr (assoc 10 (entget ent))))
	(mapcar '(lambda (str lay) (maketext pt str (cdr (assoc 40 (entget ent))) lay (cdr (assoc 7 (Entget ent)))
					  (vla-get-linespacingfactor (vlax-ename->vla-object ent))   )
		   (setq pt (polar pt (* 1.5 pi) (vla-get-linespacingdistance (vlax-ename->vla-object ent) )) ) ) lst lstl)
			    (entdel ent)
			     ) 
      )
    )
  (setvar 'cmdecho 1)
  (princ)
  )
(defun maketext (point noidungtext heighttext lay style sps / oldla)
  (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
              (cons 10 point)
              (cons 40 heighttext)
              (cons 1 noidungtext)
		  (cons 8 lay)
		  (cons 7 style)
		  (cons 44 sps)
		(cons 71 2)
		 (cons 72 1)
		  (cons 73 2)
		  ))
  )

 

cho em hỏi là nếu dữ liệu khác thì làm sao nó ra được 5 layer 5 màu như anh, có cần chỉnh lại thuộc tính layer không anh

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Doan Nguyen Van    491

Doan Nguyen Van
Đã đăng
8 phút trước, divine kai đã nói:

cho em hỏi là nếu dữ liệu khác thì làm sao nó ra được 5 layer 5 màu như anh, có cần chỉnh lại thuộc tính layer không anh

Dữ liệu khác của bạn là dữ liệu như thế nào? 

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

divine kai    0

divine kai
Đã đăng

dữ liệu 4 hàng phía trên ấy anh, với lại khi dùng lisp thì khoảng các nó bị nhảy đi một đoạn, có cách nào giữ nguyên vị trí như cũ như ban đầu không

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

divine kai    0

divine kai
Đã đăng

Em muốn học thêm một chút về lisp để có gì biết đường sửa những chỗ dễ( đỡ mất công phiền a sửa), thì nên bắt đầu vs tài liệu nào vậy anh?

Chia sẻ bài đăng này

Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×