Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 28 November 2016 - 02:02 PM

https://drive.google...WDdhR1A4Wmx6eWM

đây là file cad e đang làm, cần đưa text ra giữa đường line (layer 13). nhờ mọi người viết hộ e cái lisp đó với ạ. e cảm ơn


  • 0

#2 Danh Cong

Danh Cong

    biết lệnh linetype

  • Members
  • PipPipPipPip
  • 242 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 28 November 2016 - 02:51 PM

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 ))

  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#3 Danh Cong

Danh Cong

    biết lệnh linetype

  • Members
  • PipPipPipPip
  • 242 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 28 November 2016 - 02:54 PM

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 ))

 


  • 1

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#4 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 28 November 2016 - 03:12 PM

cảm ơn bạn nhiều :)


  • 0

#5 Bee

Bee

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 64 (tàm tạm)

Đã gửi 28 November 2016 - 04:09 PM

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)
  )


  • 1

#6 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 28 November 2016 - 04:28 PM

 

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)


  • 1

#7 Bee

Bee

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 64 (tàm tạm)

Đã gửi 28 November 2016 - 04:56 PM

 

 

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. 


  • 1

#8 Danh Cong

Danh Cong

    biết lệnh linetype

  • Members
  • PipPipPipPip
  • 242 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 28 November 2016 - 04:58 PM

 

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


  • 0

             ***  Vô lo - Vô nghĩ - Vô sầu hận  ***

***  Chẳng thương - Chẳng giận - Chẳng đau lòng  ***


#9 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 28 November 2016 - 07:11 PM

 

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...enhlN2FEZHFMMDQ

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


  • 0

#10 Bee

Bee

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 64 (tàm tạm)

Đã gửi 28 November 2016 - 07:47 PM

@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ý. ^_^
  • 0

#11 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

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

Đã gửi 28 November 2016 - 10:05 PM

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))


  • 0

#12 txquychk51

txquychk51

    biết vẽ ellipse

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

Đã gửi 29 November 2016 - 06:32 AM

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


  • -1