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

Nhờ Viết Lisp Dim hàng loạt theo phương đứng

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

Em có mấy phần chỉnh sửa mặt cắt nạo vét thường phải làm rất nhiều. Nên hnay em post vấn đề này lên mong được các bác ra tay giúp đỡ viết giúp em cái Lisp để giải quyết vấn đề ĐO HÀNG LOẠT DIMENSION THEO PHƯƠNG ĐỨNG. Chứ em đo hàng loạt Dim theo phương ngang thì đã có lệnh QuickDim rồi.

Bài toán đặt ra như sau:

            “Ta có hàng loạt các đường Polyline 1 màu đỏ, cần Dim cao độ từ các đỉnh của Polyline 1 đó tới đường Line 1 và gióng thẳng hàng Dim xuống đường Line 2”
 

Nay em nhờ các bác viết giúp em Lisp với mong muốn như sau:
+ B1: Gõ Lệnh "Dimy" (Để Dim Các Đường "Polyline 1" Theo Phương Đứng)

+ B2: Chọn 1 Loạt Các Đường "Polyline 1" Để Lấy Làm Chân Dim Thứ Nhất

+ B3: Chọn Đường Line 1 Để Lấy Làm Chân Dim Thứ 2

+ B4: Chọn Đường Line 2 Để Làm Vị Trí Đặt Dim

+ B5: Kết Thúc Lệnh Hoặc Có Thể Làm Vòng Lặp Cho Các Đối Tượng Tiếp Theo.

File Cad em gửi kèm theo đây ah.

Mong các bác giúp em vấn đề đau đầu này mà em mò bao lâu nay chưa ra.

Em xin gửi lời cám ơn chân  thành tới các bác trên Diễn Đàn :)

http://www.cadviet.com/upfiles/3/64997_test_nao_vet.dwg

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

1./ Coi file bạn gửi mà không hiểu chi hết 

2./ Nếu bạn đã QDIM được theo phương ngang được rồi thì QDIM theo phương đứng:  

-> UCS góc 90 độ thế là QDIM theo phương đứng được rồ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

Cái UCS đó dùng như thế nào vậy bác Tue? Em chưa biết cách.

Còn sau đây e gửi bác cách em thường đo Dim với cái file cad của em. Bác xem và giúp em với nhé

http://www.youtube.com/watch?v=PnAjmhsZM_U&feature=youtu.be

1./ Coi file bạn gửi mà không hiểu chi hết 

2./ Nếu bạn đã QDIM được theo phương ngang được rồi thì QDIM theo phương đứng:  

-> UCS góc 90 độ thế là QDIM theo phương đứng được rồ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

Cái UCS đó dùng như thế nào vậy bác Tue? Em chưa biết cách.

Còn sau đây e gửi bác cách em thường đo Dim với cái file cad của em. Bác xem và giúp em với nhé

http://www.youtube.com/watch?v=PnAjmhsZM_U&feature=youtu.be

 

Do chưa hiểu file của bạn....

Code Lisp của bạn đây: 

 

(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd)
(vl-load-com)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "ucs" "W")
(while (and
  (setq cur (car (entsel "\nChon Pline :")))
  (setq line (car (entsel "\nChon line1 :")))
  (setq dd (getpoint "\nChon diem dat :"))
  )
  (foreach x (Tue-ent-Lpoint cur)
  (command "._dimlinear"  x (vlax-curve-getClosestPointTo line x) x
             "._dimtedit" (entlast) (list (car x) (cadr dd) 0.0))
  )
)
)
(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "ucs" "W")
(while (and
  (setq cur (car (entsel "\nChon Pline :")))
  (setq line (car (entsel "\nChon line1 :")))
  (setq dd (getpoint "\nChon diem dat :"))
  )
  (foreach x (Tue-ent-Lpoint cur)
  (command "._dimlinear"  x (vlax-curve-getClosestPointTo line x) x
  "._dimtedit" (entlast) (list (car x) (cadr dd) 0.0))
  )
)
)
  • 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

 

Do chưa hiểu file của bạn....

Code Lisp của bạn đây: 

 

(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd)
(vl-load-com)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "ucs" "W")
(while (and
  (setq cur (car (entsel "\nChon Pline :")))
  (setq line (car (entsel "\nChon line1 :")))
  (setq dd (getpoint "\nChon diem dat :"))
  )
  (foreach x (Tue-ent-Lpoint cur)
  (command "._dimlinear"  x (vlax-curve-getClosestPointTo line x) x
             "._dimtedit" (entlast) (list (car x) (cadr dd) 0.0))
  )
)
)
(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "ucs" "W")
(while (and
  (setq cur (car (entsel "\nChon Pline :")))
  (setq line (car (entsel "\nChon line1 :")))
  (setq dd (getpoint "\nChon diem dat :"))
  )
  (foreach x (Tue-ent-Lpoint cur)
  (command "._dimlinear"  x (vlax-curve-getClosestPointTo line x) x
  "._dimtedit" (entlast) (list (car x) (cadr dd) 0.0))
  )
)
)

Cám ơn bác Tuệ rất nhiều. Lisp bác viết rất đúng ý em rồi. Nhưng em dùng có điều này mong bác giúp là: 

+ Thêm sự lựa chọn hàng loạt Polyline một lúc.

+ Và thêm hàm có thể giúp Undo trở lại trước khi Dim. Em thử thêm mấy dòng này vào Lisp mà ko được : (command "undo" "be") (command "undo" "end")

Hoặc nếu bác chỉ cho em cách sửa lisp thì tốt quá. Em gà về khoản này quá. Mong bác chỉ giú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

Cám ơn bác Tuệ rất nhiều. Lisp bác viết rất đúng ý em rồi. Nhưng em dùng có điều này mong bác giúp là: 

+ Thêm sự lựa chọn hàng loạt Polyline một lúc.

+ Và thêm hàm có thể giúp Undo trở lại trước khi Dim. Em thử thêm mấy dòng này vào Lisp mà ko được : (command "undo" "be") (command "undo" "end")

Hoặc nếu bác chỉ cho em cách sửa lisp thì tốt quá. Em gà về khoản này quá. Mong bác chỉ giúp. :)

 

Chỉnh code lại cho bạn đây: 

 

(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd i sspline)
(vl-load-com)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "undo" "be")
  (command "ucs" "W")
  (setvar "cmdecho" 0)
(while (and
           (setq i -1) (princ "\n Select Polyline:")
          (setq sspline (ssget '((0 . "*LINE"))))
          (setq line (car (entsel "\nChon line1 :")))
          (setq dd (getpoint "\nChon diem dat :"))
    )
(Repeat (sslength sspline)
  (foreach x (Tue-ent-Lpoint (ssname sspline (setq i (1+ i))))
  (command "._dimlinear"  "_non" x "_non" (vlax-curve-getClosestPointTo line x) "_non" x
             "._dimtedit" (entlast) "_non" (list (car x) (cadr dd) 0.0))
  )
)
)
  (command "ucs" "p")
  (command "undo" "end")
)

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

osmode cho chắc ăn luôn bác Tue ơi

 

Thanks! Quick code nhanh quá, không để ý ^_^. Đã bổ sung ở bài viết trên

  • 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

Thanks! Quick code nhanh quá, không để ý ^_^. Đã bổ sung ở bài viết trên

 

 

Chỉnh code lại cho bạn đây: 

Lâu lắm rồi mới lại vô cadviet, vào cái đăng nhập like bác cái đã, chúc bác luôn vui khoẻ, cảm ơn bác luôn nhiệt huyết với cadviet, cảm ơn bác luôn quan tâm tới thắc mắc của các mem.

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

 

Chỉnh code lại cho bạn đây: 

 

(defun c:dop(/ Tue-dxf Tue-ent-Lpoint cur line dd i sspline)
(vl-load-com)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ent-Lpoint(e / i Lpoint);Tue-dxf
(if (wcmatch (Tue-dxf 0 e) "*POLYLINE")
(progn
  (if (= (type e) 'VLA-OBJECT) (setq e (vlax-vla-object->ename e)))
  (setq i -1)
  (Repeat (if (wcmatch (Tue-dxf 0 e) "*POLYLINE") (fix (1+ (vlax-curve-getEndParam e))) 2)
    (setq Lpoint (append Lpoint (list (vlax-curve-getPointatParam e (setq i (1+ i))))))
  )
)
)
(if (wcmatch (Tue-dxf 0 e) "LINE")
  (setq Lpoint (append Lpoint (list (Tue-dxf 10 e) (Tue-dxf 11 e))))
)
Lpoint
)
  (command "undo" "be")
  (command "ucs" "W")
  (setvar "cmdecho" 0)
(while (and
           (setq i -1) (princ "\n Select Polyline:")
          (setq sspline (ssget '((0 . "*LINE"))))
          (setq line (car (entsel "\nChon line1 :")))
          (setq dd (getpoint "\nChon diem dat :"))
    )
(Repeat (sslength sspline)
  (foreach x (Tue-ent-Lpoint (ssname sspline (setq i (1+ i))))
  (command "._dimlinear"  "_non" x "_non" (vlax-curve-getClosestPointTo line x) "_non" x
             "._dimtedit" (entlast) "_non" (list (car x) (cadr dd) 0.0))
  )
)
)
  (command "ucs" "p")
  (command "undo" "end")
)

Cái này em mò linh tinh thì sửa được lỗi Undo như sau:

)
  (command "ucs" "p")
  (command "undo" "end")
)
)
 

(command "ucs" "p")  (command "undo" "end")))

Chân thành cám ơn Bác Tuệ và diễn đàn nhiều. Chúc các bác luôn mạnh khỏe :)

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


×