Chuyển đến nội dung
Diễn đàn CADViet
ketxu

Căn lề text + Mtext, Căn lề đối tượng

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

Không được đâu bác Bình ơi Em chạy rồi mà không di chuyển được block nào. Bác kiểm tra lại giúp em với nhé.

Tiện thể Bác thêm code di chuyển cụm text có 1 khoảng cách khi quét chọn cả text và line giống như code hôm trước Bác đã giúp em.

Hề hề hề,

Sorry vì mình không kiểm tra kỹ khi hướng dẫn bạn bổ sung code. Bạn hãy chép lại lisp dưới đây và so sánh để thấy dược lỗi và rút kinh nghiệm nhé.

Tuy nhiên do cách tư duy của người viết lisp nên lisp này sẽ chạy khá chậm và rất dễ gây nhầm lẫn khi trên bản vẽ của bạn có nhiều đường mặt đất trùng lặp.

Việc lisp bạn sửa bị lỗi là do khi tạo hai vòng lặp lồng nhau mình đã quên trả biến về giá trị ban đầu.


(defun giaodiem (a1 b1 c1)
(setq x (cadr a1)
y (+ (/ (* (- x (cadr b1)) (- (caddr c1) (caddr b1))) (- (cadr c1) (cadr b1))) (caddr b1))
)
(list 10 x y (cadddr a1))
)
;***************************************************************
(defun C:Mm()
(prompt "\nChon doi tuong di chuyen:")
(setq ss (ssget)
Q (sslength ss)
)
(setq pp (ssget "X" '((0 . "LINE") (62 . 5)))
P (sslength pp)
)
(setq i 0 j 0)
(while (< i Q ) 
(setq A (entget (ssname ss i)))
(while (< j P)

        (setq B (entget (ssname pp j)))
        (setq L10 (assoc 10 A)
                  L11 (assoc 10 B )
                  M11 (assoc 11 B )
        )

        (if (and (>= (cadr L10) (cadr L11)) (<= (cadr L10) (cadr M11))) 
            (progn
                   (setq D10 (giaodiem L10 L11 M11)
                              A (subst D10 L10 A) )
                   (entmod A)
            )

         )
          (setq j (+ j 1) )
)
(setq i (+ i 1) j 0)

)
(princ)
)

 

Về việc bổ sung thêm vào lisp này thì mình thấy nó không nên do hạn chế của lisp. Hơn nữa cách làm này không thực tạo ra hứng thú với mình. Do vậy nếu bạn vẫn muốn sửa để dùng thì mình gợi ý bạn như sau:

1/- tạo một tập chọn gồ tất cả các line trong cụm.

2/- lặp qua các line này để lấy được các cụm text line riên biệt.

3/- Với mỗi cụm sử dụng lisp hiện có để move nó về điểm tương ứng. Điểm này được lấy tương ứng với các điểm giao có được từ lisp và offset nó theo khoảng cách bạn nhập vào.

 

bạn hãy thử làm, nếu vướng mắc mình sẽ giúp thêm.

Chúc bạn vui.

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

Ngon rồi Bác Bình Ơi. Em không biết nhiều về lisp Bác Bình ơi Bác giúp thì giúp em cho chót kính nhờ bác. Em cám ơn Bác 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

Ngon rồi Bác Bình Ơi. Em không biết nhiều về lisp Bác Bình ơi Bác giúp thì giúp em cho chót kính nhờ bác. Em cám ơn Bác nhiều.

Hề hề hề,

Thú thực là không khoái lắm với cái lisp này, song vì bạn thích dùng nó nên thôi đành ngậm ...... ớt sửa chút chút để bạn xài thử. Kết cấu lisp kiểu này hơi ...... lẩm cẩm, tuy nó vẫn chạy được xong khá mất thời gian.

Của bạn đây, xài thử và cho ý kiến.


(defun giaodiem (a1 b1 c1)
(setq x (cadr a1)
y (+ (/ (* (- x (cadr b1)) (- (caddr c1) (caddr b1))) (- (cadr c1) (cadr b1))) (caddr b1))
)
(list 10 x y (cadddr a1))
)
;***************************************************************
(defun C:Mm()
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(prompt "\nChon doi tuong di chuyen:")
(setq ss (ssget)
Q (sslength ss)
)
(setq pp (ssget "X" '((0 . "LINE") (62 . 5)))
P (sslength pp)
)
(setq i 0 j 0)
(setq KC (getreal "\n Nhap khoang cach tu duong mat dat toi line ghi chu: "))
(while (< i Q )
(setq A (entget (setq en (ssname ss i))))
(while (< j P)

    	(setq B (entget (ssname pp j)))
    	(setq
              	L11 (assoc 10 B )
              	M11 (assoc 11 B )
    	)
    	(if (= (cdr (assoc 0 A)) "INSERT")
        	(progn
              	(setq L10 (assoc 10 A))

                 (if (and (>= (cadr L10) (cadr L11)) (<= (cadr L10) (cadr M11)))
                     (progn
                           (setq D10 (giaodiem L10 L11 M11)
                                   A (subst D10 L10 A) )
                      	(entmod A)
                     )            
                 )
             )
      	)

      	(if (= (cdr (assoc 0 A)) "LINE")
          	(progn
`                    (setq L10 (mid (cdr (assoc 10 A)) (cdr (assoc 11 A))))
                	(setq sst (acet-ss-to-list (setq ss1 (ssget "w" (list (- (car L10) 45) (- (cadr L10) 45))
                                                                                                 (list (+ (car L10) 45) (+ (cadr L10) 45))
                                                                                                 (list (cons 0 "text") (cons 8 "025")))))  )
                   (foreach txt sst
                           (setq pt (cdr (assoc 11 (setq enl (entget txt)))))
                           (if (> (cadr pt) (cadr L10))
                              	(entmod (subst (cons 11 (list (car L10) (+ (cadr L10) 12.5))) (assoc 11 enl) enl))
                              	(entmod (subst (cons 11 (list (car L10) (- (cadr L10) 12.5))) (assoc 11 enl) enl))
                           )
                   )
                   ;;;(setq L10 (cons 10 L10))

                   (if (and (>= (car L10) (cadr L11)) (<= (car L10) (cadr M11)))
                       (progn
                           (setq D10 (cdr (giaodiem (list 10 (car L10) (cadr L10) 0.0) L11 M11)))
                           (command "move" en ss1 ""  L10  (list (car D10) (+ (cadr D10) KC)))
                           (setq A (entget en))
                       )
                	)

          	)
      	)

      	(setq j (+ j 1) )
)
(setq i (+ i 1) j 0)

)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mid (p1 p2)
(setq pt (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)))  
)

Bạn nên lưu ý vài điều như sau:

1/- Trước khi chạy lisp nên dùng overkill để tiêu diệt bớt kẻ thù của lisp.

2/- Các thuộc tính của các line mặt đất, text, line ghi chú .... phải đảm bảo giống như trên bản vẽ bạn đã gửi. Chỉ cần các thuộc tinh này thay đổi thì lisp sẽ có thể cho bạn đi tàu bay giấy ngay.

3/- Khi quét chọn các đối tượng cần di chuyển, bạn nên quét chọn từng vùng nhỏ tránh lấy thêm vài nghìn đối tượng không mong muốn. Số lượng đối tượng này càng to thì lisp chạy càng lâu và không ngoại trừ nó tẩu hỏa nhập loanh quanh thì bạn mệt người.

4/- Lisp yêu cầu bạn chọn cả block, cả các cụm text-line cần di chuyển trong một lần chọn duy nhất nên bạn cứ nhẩn nha mà chọn cho tới khi đủ khoái. Miễn rằng đừng chọn nhầm mà tự làm khổ mình. Trong trường hợp nhỡ nhầm, hãy cứ yên tâm chạy lisp rồi undo một phát nó sẽ trả về nguyên trạng trước khi chạy lisp. Nếu không muốn mất thời gian ngồi đợi có thể nhấn ESC rồi nhập lệnh undo, end. Sau đó undo một phát là nó quên hết những gì đã làm và trả cho bạn bản vẽ u như kỵ.

5/- Kết quả của lisp là chuyển các block trên bản vẽ mà bạn cần chuyển về nằm trên đường line mặt đất với tọa độ x không thay đổi. các cụm text-line sẽ chuyển tới vị trí cách đường line mặt đất một khoảng mà bạn được yêu cầu nhập vô trước đó và nằm cùng toạc độ x vốn có của điểm giữa line trong mỗi cụm. Đồng thời nó căn chỉnh cho các text nằm ngay ngắn với line theo một trật tự xác định. Nếu muốn các cụm này nằm trên , dưới hay chình ình giữa đường line mặt đất thì bạn nhập giá trị khoảng cách này là các số lớn hơn, nhỏ hơn hay bằng 0.

 

Chúc bạn một năm sắp mới vui vẻ....

Hề hề hề

  • 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

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


×