Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
txquychk51

Nhờ Chỉnh Sửa Text Ra Giữa Line

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

Ko viết cho bạn lisp mới, vì thấy yêu cầu này chỉ dành cho trường hợp đặt biệt.  Với lại xem bản vẽ của bạn có quá nhiều đối tượng nên viết thì tui cũng chưa đủ trình độ để viết.

Do đó tui chỉ nói bạn cách làm thủ công qua việc sắp xếp theo trục X- Trục Y thôi.

 

B1. Thay đổi thuộc tính text của bạn về "Bottom- Center" bằng Express:   Express - Text - Jutify Text - " Chọn các text cần sắp xếp" - BC

B2: Sử dụng lệnh sắp xếp theo trục X- Trục Y: Gõ "SX" hoặc SY và làm theo hướng dẫn.

 

So sánh thì cũng nhanh hơn  với việc sử dụng lệnh move.

Lisp sắp xếp: Sx - Sy

;;;;;; SX: Sap xep doi tuong thang hang theo phuong X
 
;;;;;; SY: Sap xep doi tuong thang hang theo phuong Y
 
 
 
(defun c:sx (/ *error* ) 
(command "undo" "mark")
(setvar "cmdecho" 0)
(defun *error* (msg)
  (setvar "osmode" olosmode)
  )
 
 
(while (not
(setq pt1 (getpoint "Chon diem moc de sap xep"))
))
(while
(setq doituong (ssget))
(While (not
(setq pt2 (getpoint "Chon diem giong de sap xep"))
))
(setq pt3 (list (car pt2) (cadr pt1)))
(setq olosmode (getvar "osmode"))
(setvar "osmode" 0)
(command "move" doituong "" pt2 pt3)
(setvar "osmode" olosmode)
)
(command "undo" "end")
(princ ))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
(defun c:sy (/ *error*) 
(defun *error* (msg)
  (setvar "osmode" olosmode)
)
 
(command "undo" "mark")
(setvar "cmdecho" 0)
 
 
 
(while (not
(setq pt1 (getpoint "Chon diem moc de sap xep"))
))
(while
(setq doituong (ssget))
(While (not
(setq pt2 (getpoint "Chon diem giong de sap xep"))
))
(setq pt3 (list (car pt1) (cadr pt2)))
(setq olosmode (getvar "osmode"))
(setvar "osmode" 0)
(command "move" doituong "" pt2 pt3)
(setvar "osmode" olosmode)
)
(command "undo" "end")
(princ ))
  • Vote tăng 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

Lisp Sx- Sy

 

 

;;;;;; SX: Sap xep doi tuong thang hang theo phuong X
 
;;;;;; SY: Sap xep doi tuong thang hang theo phuong Y
 
 
 
(defun c:sx (/ *error* ) 
(command "undo" "mark")
(setvar "cmdecho" 0)
(defun *error* (msg)
  (setvar "osmode" olosmode)
  )
 
 
(while (not
(setq pt1 (getpoint "Chon diem moc de sap xep"))
))
(while
(setq doituong (ssget))
(While (not
(setq pt2 (getpoint "Chon diem giong de sap xep"))
))
(setq pt3 (list (car pt2) (cadr pt1)))
(setq olosmode (getvar "osmode"))
(setvar "osmode" 0)
(command "move" doituong "" pt2 pt3)
(setvar "osmode" olosmode)
)
(command "undo" "end")
(princ ))
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
(defun c:sy (/ *error*) 
(defun *error* (msg)
  (setvar "osmode" olosmode)
)
 
(command "undo" "mark")
(setvar "cmdecho" 0)
 
 
 
(while (not
(setq pt1 (getpoint "Chon diem moc de sap xep"))
))
(while
(setq doituong (ssget))
(While (not
(setq pt2 (getpoint "Chon diem giong de sap xep"))
))
(setq pt3 (list (car pt1) (cadr pt2)))
(setq olosmode (getvar "osmode"))
(setvar "osmode" 0)
(command "move" doituong "" pt2 pt3)
(setvar "osmode" olosmode)
)
(command "undo" "end")
(princ ))

 

  • Vote tăng 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

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

  • Vote tăng 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

 

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

@ Bee: ngày nay bình đẳng gới rùi. trâu đi tìm cọc hay cọc đi tìm trâu không còn là vấn đề ?!

(line-> text or text->line)

  • Vote tăng 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

 

 

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

@ Bee: ngày nay bình đẳng gới rùi. trâu đi tìm cọc hay cọc đi tìm trâu không còn là vấn đề ?!

(line-> text or text->line)

Hôm nay đang rảnh mình vào giải trí chút thôi mà  Gia Bạch. :) Không hiểu rõ ý Gia Bạch lắm nhưng cũng lơ mơ đc tí. :) Cứ nói rõ đi cho mình dễ hiểu và còn rút kinh nghiệm. 

  • Vote tăng 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

 

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

 

 

Em cũng nghĩ nếu viết cho 1 text và 1 line thì được.

Nhưng quét chọn hàng loạt đối tượng thì đâu có thuật toán nào giải quyết điều này, kiểu gì cũng có vài cái đặc biệt phải giải quyết bằng tay  :)  :)  :)

Cái dòng " (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT")))) " đó anh.

Hì hì. Em lười viết bảo bạn ý rèn tay cho nó quen :P

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

 

Cai nay` dễ mà ^_^ @Danh Cong

 

@txquychk

Viết nhanh cái lisp này, dùng tạm nhé ^_^

(defun c:test (/ osm ss p10 p11 pt p1 p2 ss_txt txt pt1)
  (setq osm (getvar 'osmode))
  (setvar 'osmode 0)
  (if (setq ss (ssget (list (cons 0 "LINE") (cons 8 "13.Thin"))))
    (progn
      (command "_zoom" "obj" ss "")
      (mapcar '(lambda (obj)
                 (setq p10 (cdr (assoc 10 (entget obj))))
                 (setq p11 (cdr (assoc 11 (entget obj))))
                 (setq pt (polar p10 (angle p10 p11) (/ (distance p10 p11) 2)))
                 (setq p1 (polar p10 (/ pi 2) 4.))
                 (setq p2 (polar p11 (/ pi 2) 4.))                 
                 (setq ss_txt (ssget "_C" p1 p11 '((0 . "TEXT"))))
                 (if (not (null ss_txt))
                   (progn
                     (setq txt (ssname ss_txt 0))
                     (setq pt1 (list (car pt) (cadr (cdr (assoc 10 (entget txt)))) 0.0))
                     (vlax-put (vlax-ename->vla-object txt) 'Alignment 1)
                     (vlax-put (vlax-ename->vla-object txt) 'TextAlignmentPoint pt1)
                     );progn then
                   );if
                 )
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
              )
      (command "_zoom" "P")
      )
    (princ "\nBan da khong chon LINE.")
    )
  (setvar 'osmode osm)
  (princ)
  )

cảm ơn a đã quan tâm, e phải mất cả buổi để chỉnh nó, giờ có lisp thì chỉ mất mấy phút. nhưng e gặp phải vấn đề là text bị chồng lên nhau ạ (sai vị trí)

https://drive.google.com/open?id=0B5iJE54fhfEIenhlN2FEZHFMMDQ

đây là file kết quả ạ. ở cột cuối cùng, anh vào kiểm tra hộ e vớ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

@Danh Cong sửa thêm xem nào. Thêm đoạn check vị trí của text nằm giữa đoạn thẳng thì mới xử lý. ^_^

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

Cho trâu nó tự đi tìm cọc phát:

(defun c:tt  (/ enl ent i osm p10 pte ptm pts ssl sst)
  (if (setq sst (ssget '((0 . "TEXT") (8 . "06.Text1.8,03.Reinf1"))))
    (progn (setq osm (getvar 'osmode))
           (setvar 'osmode 0)
           (repeat (setq i (sslength sst))
             (setq ent (ssname sst (setq i (1- i)))
                   p10 (cdr (assoc 10 (entget ent))))
             (and (setq ssl (ssget "_F" (list p10 (polar p10 (* 1.5 pi) 4.)) '((0 . "LINE") (8 . "13.Thin"))))
                  (setq enl (ssname ssl 0))
                  (setq pts (cdr (assoc 10 (entget enl)))
                        pte (cdr (assoc 11 (entget enl)))
                        ptm (mapcar '(lambda (x y) (* (+ x y) 0.5)) pts pte))
                  (entmod (append (entget ent) (list (cons 72 1) (cons 11 ptm) (cons 73 1))))))
           (setvar 'osmode osm)))
  (princ))

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

Cho trâu nó tự đi tìm cọc phát:

(defun c:tt  (/ enl ent i osm p10 pte ptm pts ssl sst)

  (if (setq sst (ssget '((0 . "TEXT") (8 . "06.Text1.8,03.Reinf1"))))

    (progn (setq osm (getvar 'osmode))

           (setvar 'osmode 0)

           (repeat (setq i (sslength sst))

             (setq ent (ssname sst (setq i (1- i)))

                   p10 (cdr (assoc 10 (entget ent))))

             (and (setq ssl (ssget "_F" (list p10 (polar p10 (* 1.5 pi) 4.)) '((0 . "LINE") (8 . "13.Thin"))))

                  (setq enl (ssname ssl 0))

                  (setq pts (cdr (assoc 10 (entget enl)))

                        pte (cdr (assoc 11 (entget enl)))

                        ptm (mapcar '(lambda (x y) (* (+ x y) 0.5)) pts pte))

                  (entmod (append (entget ent) (list (cons 72 1) (cons 11 ptm) (cons 73 1))))))

           (setvar 'osmode osm)))

  (princ))

a có thể chỉnh lisp sao cho kết quả: justify text là center (hiện tại là bottom center); tọa độ y không đổi (hiện tại là text được đưa về bottom center và nằm tại trung điểm đoạn line). và thay đổi bán kính text tìm line bằng cách nào ạ. em cảm ơn

  • Vote giảm 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  

×