Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
10 replies to this topic

#1 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 08 January 2014 - 08:50 AM

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.c...est_nao_vet.dwg


  • 0

#2 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 08 January 2014 - 09:10 AM

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 đó


  • 0

#3 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 08 January 2014 - 09:28 AM

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.c...eature=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 đó


  • 0

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 08 January 2014 - 10:00 AM

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.c...eature=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))
  )
)
)

  • 1

#5 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 08 January 2014 - 11:20 AM

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


  • 0

#6 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 08 January 2014 - 11:50 AM

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

  • 0

#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 08 January 2014 - 12:04 PM

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


  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 08 January 2014 - 12:07 PM

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


  • 1

#9 quansla

quansla

    biết lệnh xclip

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

Đã gửi 08 January 2014 - 01:25 PM

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.


  • 0

#10 huaductiep

huaductiep

    biết vẽ rectang

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

Đã gửi 08 January 2014 - 03:57 PM

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


  • 0

#11 Thai.binh_club

Thai.binh_club

    biết zoom

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

Đã gửi 13 October 2016 - 10:31 PM

Các bác có thể xem lại hộ e lisp này được không ạ. Em không dùng được ạ, toàn báo lỗi "nil" ạ. Em xin chân thành cảm ơn.


  • 0