[Sửa Lisp] Nhờ các bác xem và sửa dùm em LISP CONVRT TEXT 2D SANG TEXT 3D

[thanhduan2407 272]

Chào các bác!

Em đang viết lại LISP Convert Text 2D sang Text 3D nhưng đang vướng một lỗi chỗ nào đó mà không thể mò ra được. Các Text vẫn không thể cập nhật được cao độ từ nội dung Text. Các bác xem và chỉ dùm em chỗ sai. Cảm ơn các bác nhiều.

(defun C:00(/ ss0 ss item Caodo Ma_Pnt Tdo Pnt)
(setq ss0 (ssget (list (cons 0  "TEXT"))))
(setq ss (acet-ss-to-list ss0))
(foreach item ss
	(setq temp  (entget item))
	(setq Caodo  (cdr (assoc 1 temp)))
	(setq Ma72 (car (TD:Ma_And_Pnt item )))
	(setq Ma73 (cadr (TD:Ma_And_Pnt item )))
	(setq Ma_Pnt (caddr (TD:Ma_And_Pnt item )))
	(setq Pnt  (cdr (assoc Ma_Pnt temp)))
	(entmod
		(subst (list Ma_Pnt (car Pnt) (cadr Pnt) (atof Caodo)) (assoc Ma_Pnt temp)
			(subst (cons 72 Ma72) (assoc 72 temp)
				       (subst (cons 73 Ma73) (assoc 73 temp) temp)
			)
		)
	)
   
)
(princ)
)

(defun TD:Ma_And_Pnt (Ent / e z p   )
(setq e (entget Ent))
(setq  Ma72 (cdr (assoc 72 e))
       Ma73 (cdr (assoc 73 e))
)
(setq Ma7273Pnt (list '(0 0 10) '(2 0 11) '(1 0 11) '(3 0 11) '(4 0 11)
		      '(5 0 10) '(0 3 10) '(1 3 11) '(2 3 11) '(0 2 11)
		      '(1 2 11) '(2 2 11) '(0 1 11) '(1 1 11) '(2 1 11)
		)
)
(setq Ma_And_Pnt (nth 0 (vl-remove nil (mapcar '(lambda(x) (if (and (= Ma72 (car x) ) (= Ma73 (cadr x))) x nil)) Ma7273Pnt))))
Ma_And_Pnt
)

[Doan Van Ha 3.194]

Hình như lisp của bạn post lên bị lỗi. Thay chữ "Ma" cuối cùng bằng dấu ngoặc đóng ")" nhé.

[thanhduan2407 272]

Do up lên diễn đàn bị như thế đó bác. 

Em chạy LISP mượt, nhưng kết quả không như mong muốn. Tọa độ Z của nó vẫn không cập nhật.

Có một số lisp convert Text tuy nhiên định dạng nó thay đổi.

Lisp này của Lee Mac nhưng cũng không khắc phục được căn chỉnh Justify.

(defun c:CVT3D ( / e i p s z )
(if
	(setq s (ssget (list (cons 0  "*TEXT,MTEXT"))))
	(repeat (setq i (sslength s))
		(setq e (entget (ssname s (setq i (1- i))))
		      z (atof (cdr (assoc 1 e)))
		)
		(if (or (= "MTEXT" (cdr (assoc 0 e)))
			(and (zerop (cdr (assoc 72 e))) (zerop (cdr (assoc 73 e))))
		    )
			(progn
				(setq p (assoc 10 e))
				(entmod (subst (list 10 (cadr p) (caddr p) z) p e))
			)
			(progn
				(setq p (assoc 11 e))
				(entmod
					(subst (list 10 (cadr p) (caddr p) z) (assoc 10 e)
						(subst (list 11 (cadr p) (caddr p) z) (assoc 11 e) e)
					)
				)
			)
		)
	)
)
(princ)
)

[Doan Van Ha 3.194]

Tôi sửa "Ma" thành ")" thì Text thay đổi ngon lành. Tuy nhiên, nếu chưa biết lý do thì bạn hoặc Regen hoặc thêm hàm entupd sau khi entmod thử xem.

[thanhduan2407 272]

LISP em viết chỉ convert được kiểu Justify là: Left, Fit, Top Left

Không hiểu nguyên nhân vì sao?

Em đã xem từng kiểu căn chỉnh Justify của từng Text:

[thanhduan2407 272]

Sau khi entupd vẫn không được bác Hạ ạ.

(defun C:00(/ ss0 ss item Caodo Ma_Pnt Tdo Pnt)
(setq ss0 (ssget (list (cons 0  "TEXT"))))
(setq ss (acet-ss-to-list ss0))
(foreach item ss
	(setq temp  (entget item))
	(setq Caodo  (cdr (assoc 1 temp)))
	(setq Ma72 (car (TD:Ma_And_Pnt item )))
	(setq Ma73 (cadr (TD:Ma_And_Pnt item )))
	(setq Ma_Pnt (caddr (TD:Ma_And_Pnt item )))
	(setq Pnt  (cdr (assoc Ma_Pnt temp)))
	(entmod
		(subst (list Ma_Pnt (car Pnt) (cadr Pnt) (atof Caodo)) (assoc Ma_Pnt temp)
			(subst (cons 72 Ma72) (assoc 72 temp)
				       (subst (cons 73 Ma73) (assoc 73 temp) temp)
			)
		)
	)
  	(entupd item)
   
)
(princ)
)

[tien2005 242]

Bạn dùng vla-move hay sử dụng (vla-put-insertionpoint (vlax-ename->vla-object item) (vlax-3d-point pt2))

[Doan Van Ha 3.194]

Đúng như bạn tien2005 nói, vừa sửa xong, up cho bạn luôn.

(defun C:01(/ ss0 ss item Caodo Pn)

 (vl-load-com)

 (setq ss0 (ssget (list (cons 0  "TEXT"))))

 (setq ss (acet-ss-to-list ss0))

 (foreach item ss

  (setq temp (entget item))

  (setq Caodo (cdr (assoc 1 temp)))

  (setq pt (cdr (assoc 10 temp)))

  (vla-put-InsertionPoint (vlax-ename->vla-object item) (vlax-3d-point (list (car pt) (cadr pt) (atof caodo))))))

 

[thanhduan2407 272]

Đúng như bạn tien2005 nói, vừa sửa xong, up cho bạn luôn.

(defun C:01(/ ss0 ss item Caodo Pn)

 (vl-load-com)

 (setq ss0 (ssget (list (cons 0  "TEXT"))))

 (setq ss (acet-ss-to-list ss0))

 (foreach item ss

  (setq temp (entget item))

  (setq Caodo (cdr (assoc 1 temp)))

  (setq pt (cdr (assoc 10 temp)))

  (vla-put-InsertionPoint (vlax-ename->vla-object item) (vlax-3d-point (list (car pt) (cadr pt) (atof caodo))))))

 

Lisp rất tuyệt. Cảm ơn bác tien2005 và bác Doan Van Ha nhiều.

Em cũng biết ít hàm vla- nên không biết để sử dụng.

Có hàm này thì nhanh rồi.

Tuy vấn đề tìm lỗi chưa được giải quyết nhưng em sẽ bỏ ý định này. Dùng cái của bác. ^^

Em Like 2 bác rồi.   :wub: