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, divine kai đã nói:

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?

http://hattesale.com/tin-tuc/SACH-HOC-LAP-TRINH-AUTO-LISP.htm

Bạn đọc ở đây 

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
6 phút trước, divine kai đã nói:

còn dữ liệu 4 hàng thì sao anh ? như em cmt ở trên

4 hàng thì như mình trả lời ở lisp trước, cái này cũng như vậy 

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
1 phút trước, Doan Nguyen Van đã nói:

4 hàng thì như mình trả lời ở lisp trước, cái này cũng như vậy 

chủ yếu là vị trí text bị thay đổi do dữ liệu 4-5 hàng , muốn giữ nguyên vị trí thì làm cách nào 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
18 giờ trước, divine kai đã nói:

chủ yếu là vị trí text bị thay đổi do dữ liệu 4-5 hàng , muốn giữ nguyên vị trí thì làm cách nào anh

Đã giải quyết vấn đề 4-5 hàng cho bạn, chọn 3 hay 4 hay 5 hàng đều được  

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str pref)
  (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)))
      (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 (or (= (length lst) 4)
	    (= (length lst) 5) )(progn
			    (setq pt (cdr (assoc 10 (entget ent))))
			    (setq pref (vl-string-right-trim "1234567890" (car lst)))			    
	(mapcar '(lambda (str lay) (if (and (/= str (car lst)) (/= pref "")) (setq str (strcat pref str)))
		   (maketext pt str lay 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 lay entg / oldla)
  (vla-move (vla-copy (vlax-ename->vla-object entg)) (vlax-3d-point (cdr (assoc 10 (entget entg)))) (vlax-3d-point point))
  (vla-put-textstring (vlax-ename->vla-object (entlast)) noidungtext)
  (vla-put-layer (vlax-ename->vla-object (entlast)) lay)
  (vla-put-color (vlax-ename->vla-object (entlast)) 256))

 

  • 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

ndtnv    481

ndtnv
Đã đăng

Lập trình nguy hiểm

(entmake (entget entg))

Không biết mtext có ảnh hưởng gì không.

Cách đây vài năm tôi áp dụng cho dim, chỉnh vị trí dim line 1 dim. Save, close rồi open lại sẽ thấy.

  • 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
10 phút trước, ndtnv đã nói:

Lập trình nguy hiểm

(entmake (entget entg))

Không biết mtext có ảnh hưởng gì không.

Cách đây vài năm tôi áp dụng cho dim, chỉnh vị trí dim line 1 dim. Save, close rồi open lại sẽ thấy.

E chưa thử với Dim, test như bác nói thì k thấy ảnh hưởng gì, nhưng để cho chắc thì e đã sửa lại code rồi. Cảm ơn bác đã nhắc

  • 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
23 giờ trước, Doan Nguyen Van đã nói:

Đã giải quyết vấn đề 4-5 hàng cho bạn, chọn 3 hay 4 hay 5 hàng đều được  


(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str pref)
  (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)))
      (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 (or (= (length lst) 4)
	    (= (length lst) 5) )(progn
			    (setq pt (cdr (assoc 10 (entget ent))))
			    (setq pref (vl-string-right-trim "1234567890" (car lst)))			    
	(mapcar '(lambda (str lay) (if (and (/= str (car lst)) (/= pref "")) (setq str (strcat pref str)))
		   (maketext pt str lay 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 lay entg / oldla)
  (vla-move (vla-copy (vlax-ename->vla-object entg)) (vlax-3d-point (cdr (assoc 10 (entget entg)))) (vlax-3d-point point))
  (vla-put-textstring (vlax-ename->vla-object (entlast)) noidungtext)
  (vla-put-layer (vlax-ename->vla-object (entlast)) lay)
  (vla-put-color (vlax-ename->vla-object (entlast)) 256))

 

em cảm ơn a rất nhiề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 10/9/2019 tại 09:16, Doan Nguyen Van đã nói:

Đã giải quyết vấn đề 4-5 hàng cho bạn, chọn 3 hay 4 hay 5 hàng đều được  


(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str pref)
  (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)))
      (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 (or (= (length lst) 4)
	    (= (length lst) 5) )(progn
			    (setq pt (cdr (assoc 10 (entget ent))))
			    (setq pref (vl-string-right-trim "1234567890" (car lst)))			    
	(mapcar '(lambda (str lay) (if (and (/= str (car lst)) (/= pref "")) (setq str (strcat pref str)))
		   (maketext pt str lay 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 lay entg / oldla)
  (vla-move (vla-copy (vlax-ename->vla-object entg)) (vlax-3d-point (cdr (assoc 10 (entget entg)))) (vlax-3d-point point))
  (vla-put-textstring (vlax-ename->vla-object (entlast)) noidungtext)
  (vla-put-layer (vlax-ename->vla-object (entlast)) lay)
  (vla-put-color (vlax-ename->vla-object (entlast)) 256))

 

anh ơi, anh có thể chỉnh lisp này cho ra đối tượng là text như lisp cũ, được không anh vì khi là đối tượng mtext khi em X ra thì nó bị vỡ đối tượng, em muốn X ra để sửa lỗi font

 

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 10/9/2019 tại 09:16, Doan Nguyen Van đã nói:

nó bị như vầy nè anh.... 


(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str pref)
  (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)))
      (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 (or (= (length lst) 4)
	    (= (length lst) 5) )(progn
			    (setq pt (cdr (assoc 10 (entget ent))))
			    (setq pref (vl-string-right-trim "1234567890" (car lst)))			    
	(mapcar '(lambda (str lay) (if (and (/= str (car lst)) (/= pref "")) (setq str (strcat pref str)))
		   (maketext pt str lay 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 lay entg / oldla)
  (vla-move (vla-copy (vlax-ename->vla-object entg)) (vlax-3d-point (cdr (assoc 10 (entget entg)))) (vlax-3d-point point))
  (vla-put-textstring (vlax-ename->vla-object (entlast)) noidungtext)
  (vla-put-layer (vlax-ename->vla-object (entlast)) lay)
  (vla-put-color (vlax-ename->vla-object (entlast)) 256))

image.png.b825273a6539058889eeb6ac417bb6cd.png

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, divine kai đã nói:

anh ơi, anh có thể chỉnh lisp này cho ra đối tượng là text như lisp cũ, được không anh vì khi là đối tượng mtext khi em X ra thì nó bị vỡ đối tượng, em muốn X ra để sửa lỗi font

 

Oke rồi nhưng độ giãn của text không chỉnh được như MText  

(defun c:te (/ ss lstl ent ss1 lst lst2 en en2 en3 str pref)
  (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)))
      (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 (or (= (length lst) 4)
	    (= (length lst) 5) )(progn
			    (setq pt (cdr (assoc 10 (entget ent))))
			    (setq pref (vl-string-right-trim "1234567890" (car lst)))			    
	(mapcar '(lambda (str lay) (if (and (= str (car lst)) (/= pref "")) (setq str (substr str (1+ (strlen pref)))) )
		   (maketext pt str lay 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 lay entg )
  (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText")
              (cons 10 point)
              (assoc 40 (entget entg))
              (cons 1 noidungtext)
		  (cons 11 point)
		  (cons 8 lay)
		  (assoc 7 (entget entg))
		(cons 71 0)
		 (cons 72 1)
		  (cons 73 3)
		  ))
  )

 

  • 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

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
×