Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
Truong_AAn

[Yêu cầu] lisp xuất tọa độ dim

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

Trong cad có lệnh DOR để xuất tọa độ tuyệt đối mình thấy rất hay. Nhưng ngồi đánh từng cái thì lâu quá khống biết lisp có hỗ trợ xuất một lần được không nhỉ. Nếu được nhờ anh em cadviet viết giúp mình lisp xuất tọa độ như hình minh họa.
Yêu cầu lisp
Đánh lệnh/chọn góc tọa độ/ chọn chi tiết => kết quả như hình ( dim tọa độ xuất ra là layer hiện hành)
File DWG: http://www.cadviet.com/upfiles/3/106444_auto_dim_2.dwg
Cảm ơn các bạn 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

Trong cad có lệnh DOR để xuất tọa độ tuyệt đối mình thấy rất hay. Nhưng ngồi đánh từng cái thì lâu quá khống biết lisp có hỗ trợ xuất một lần được không nhỉ. Nếu được nhờ anh em cadviet viết giúp mình lisp xuất tọa độ như hình minh họa.

Yêu cầu lisp

Đánh lệnh/chọn góc tọa độ/ chọn chi tiết => kết quả như hình ( dim tọa độ xuất ra là layer hiện hành)

File DWG: http://www.cadviet.c..._auto_dim_2.dwg

Cảm ơn các bạn nhiều!

Hề hề hề,

Chưa hiểu hết yêu cầu của bạn nên đoán mò và làm thử cái ni, không biết có đúng ý bạn không???

Lưu ý rằng có nhẽ nó chưa hoàn toàn đáp ứ đúng ý bạn và còn hơi rườm rà. Trong quá trình bạn dim, với mỗi điểm đều có hai lần ghi kich thước, lần 1 là tọa độ x lần 2 là tọa độ y. Bạn toàn quyền lựa chọn các vị trí đặt dim. Nếu thấy dim nào không cần ghi thì bạn chỉ việc bỏ qua nó bằng cách nhấn enter khi nó yêu cầu nhập điểm đặt dim. Việc ghi này mình mới chỉ làm cho các line và lwpolyline. với các circle hay các arc, elip bạn phải có đường line xác định tâm và dựa vào đó mà ghi cho phù hợp.

Hy vọng bạn chưa hài lòng.


(defun c:dimor ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(command "undo" "be")
(setvar "osmode" 0)
(command "ucs" "n" "o" (getpoint))
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(foreach pl ssl
    (if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
        (setq plst (acet-geom-vertex-list pl))
        (setq plst (list (trans (cdr (assoc 10 (entget pl))) 0 1) (trans (cdr (assoc 11 (entget pl))) 0 1)))
    )
    (foreach ver plst
          (command "dimordinate" ver "x" (getpoint ver) "")
          (command "dimordinate" ver "y" (getpoint ver) "")
    )
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

 

Chúc bạn không buồn.

  • 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

Hề hề hề,

Chưa hiểu hết yêu cầu của bạn nên đoán mò và làm thử cái ni, không biết có đúng ý bạn không???

Lưu ý rằng có nhẽ nó chưa hoàn toàn đáp ứ đúng ý bạn và còn hơi rườm rà. Trong quá trình bạn dim, với mỗi điểm đều có hai lần ghi kich thước, lần 1 là tọa độ x lần 2 là tọa độ y. Bạn toàn quyền lựa chọn các vị trí đặt dim. Nếu thấy dim nào không cần ghi thì bạn chỉ việc bỏ qua nó bằng cách nhấn enter khi nó yêu cầu nhập điểm đặt dim. Việc ghi này mình mới chỉ làm cho các line và lwpolyline. với các circle hay các arc, elip bạn phải có đường line xác định tâm và dựa vào đó mà ghi cho phù hợp.

 

Chúc bạn không buồn.

Cảm ơn bác Bình đã nhiệt tình giúp đỡ. Em đã test thử lisp và gặp rắc rối sau.

- Khi đánh lệnh dimor cad yêu cầu Specify new origin point <0,0,0>: nhưng nó tắt mất chế độ truy bắt điểm mà bấm F3 cũng không được nên phải dùng lên OS mới thiết lập lại được

- Sau khi đặt được hệ trục tại vị trí cần thiết thì cad yêu cầu select object: sau đó mình chọn đối tượng thì cad bắt một điểm bất kì với dòng yêu cầu sau Specify leader endpoint or [Xdatum/Ydatum/Mtext/Text/Angle]: nhưng khi chọn x hoặc y enter thì nó không xuất được tọa độ mà nó nhảy sang vị trí khác nhưng khi bấm ESC thì nó đánh ra tọa độ và báo như này: cancel*

; error: Function cancelled

Specify leader endpoint or [Xdatum/Ydatum/Mtext/Text/Angle]:

Dimension text = 9.4137

Nhờ Bác hoàn thiện thêm và sửa các lỗi đó giúp em với. Bác có thể cho cad xuất ra cả X và Y sau đó em Autotay bớt cái thừa cũng được.

Với lại bác bình cho em hỏi một xíu trong trường hợp này là tọa độ tuyệt đối hay tương đối vậy. Nói thật em cứ lộn tùm phèo giữa tuyệt và tương bác ah. hihi chắc còn đi học chắc học lại vài lần nữa cho nhớ nhưng tiếc là không có được cơ hội đó nên có gì bác chỉ giúp em với nha. cảm ơn bác rất nhiều

 

PS:

Ngày mai mình phản hồi tiếp nha vì ở nhà ko có internet

:wacko:

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

nhoc lại xin góp vui tí ^^ hen, lsp của anh Bình ko có lỗi chắc bạn chưa hỉu cách sử dụng chăng :)

- lsp này ko cần chế độ bắt điểm tiện hơn bạn ah bạn bật f3 ko đc vì trong lsp đã set biến osmode về 0 rùi thì bật f3 cũng ko đc đâu ^^, lúc đầu nó hỏi là cho bạn chọn mún thiết lập qui ước góc tọa độ ( 0,0,0) ở đâu, anh Bình ko cho bắt điểm có thể ý mún là lúc này bạn enter hay space 1 cái nó sẽ tự động lấy gốc (0,0,0) mặc định của cad thui ko cần chọn điểm làm mốc là chỗ khác ^^, sau đó chọn đối tượng thì lsp sẽ tự động ghi tọa độ x trước, y sau ở 1 điểm bất kỳ trên đối tượng ko cần mình bấm trên command x hay y, lúc ghi x hay y nó sẽ có đường mờ mờ cho bạn chọn hướng ghi text, quyết định đc hướng chỉ cần click chuột trái để ghi là đc như bạn bấm x hoặc y trên command rùi enter thì đường nhiên nó sẽ nhảy qua điểm khác rùi ^^, sau khi xong điểm đó nó tự động nhảy qua điểm khác ah tương tự vậy cho đến hết đối tượng, khi nó tự nhảy đến 1 điểm nào đó mà bạn ko mún ghi thì như anh Bình hướng dẫn bấm enter nó sẽ tự động nhảy qua điểm khác thui.

-Việc bạn nhấn esc giữa chừng nó chỉ sẽ ra đc tọa độ X của điểm và thoát hẳn lệnh lun rùi nên ko ra đc y ^^

-Tọa độ tuyệt đối và tương đối bạn xem thử có hỉu ko cái này là bài bên lớp cad cơ bản nhoc học anh Hoanh, nhoc trình bày dở sợ bạn hem hỉu lấy của anh Hoanh cho chắc ^^

104473_222222222222222222222.jpg

Lsp nhoc xin mạn phép anh Bình thử chỉnh lại xíu hen ^^, đợi xíu xong bài này nhoc nghiên cứu lsp rùi post sau :D

  • 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

sau 1 hồi mày mò nhoc đã mò ra 1 cách tào lao hột dưa :D đưa thêm điều kiện cho bạn chọn thích tắt hay mở chế độ bắt điểm, nếu chọn tắt sau khi xong lệnh chế độ bắt điểm mà bạn set lúc đâu sẽ trở lại với bạn ^^, nếu bạn chọn mở xem như ko có gì thay đổi, lúc đầu bạn chọn thế nào thì nó vẫn thế rứa :D

(defun c:dimor (/ ssl plst a b c)
(vl-load-com)
(setq b (getvar "osmode"))
(setq c (getint "\nTat hay bat bat diem 1 tat 2 mo: "))
(if (= c 1)
(setq a (setvar "osmode" 0)) (setq b (getvar "osmode")))
(command "undo" "be")
(command "ucs" "n" "o" (getpoint))
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(foreach pl ssl
	(if (= (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
    	(setq plst (acet-geom-vertex-list pl))
    	(setq plst (list (trans (cdr (assoc 10 (entget pl))) 0 1) (trans (cdr (assoc 11 (entget pl))) 0 1)))
	)
	(foreach ver plst
      	(command "dimordinate" ver "x" (getpoint ver) "")
      	(command "dimordinate" ver "y" (getpoint ver) "")
	)
)
(command "undo" "e")
(setvar "osmode" B)
(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

sau 1 hồi mày mò nhoc đã mò ra 1 cách tào lao hột dưa :D đưa thêm điều kiện cho bạn chọn thích tắt hay mở chế độ bắt điểm, nếu chọn tắt sau khi xong lệnh chế độ bắt điểm mà bạn set lúc đâu sẽ trở lại với bạn ^^, nếu bạn chọn mở xem như ko có gì thay đổi, lúc đầu bạn chọn thế nào thì nó vẫn thế rứa :D

....

Tùy chọn tắt hay mở chế độ bắt điểm không cần thiết đâu bạn

bởi chỉ cần khi lisp vẽ thì mới tắt bắt điểm thôi

@Truong_AAn:

Bạn thử lisp này xem sao:

(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))))
)
(if (wcmatch (Tue-dxf 0 e) "ARC,CIRCLE")
 (setq Lpoint (append Lpoint  (list (Tue-dxf 10 e)  )))
)
Lpoint
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

 (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
 (setq L (sslength ssg))
 (Repeat L
   	(setq ename (ssname ssg (setq L (1- L))))
   (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
 )
)
(defun c:dorr (/ oldos ssd)
(vl-load-com)
(setq kc 6.0)
(setq oldos (getvar "osmode"))
(command "undo" "be")
 (setq ssd (Tue-ss-list (list (ssget '((0 . "*LINE") (8 . "Visible line (Duong nhin thay)"))))))
(command "ucs" "m" (setq goc (getpoint "\n Chon goc toa do tuong doi :")))

 (setvar "osmode" 0)
 (foreach x ssd
(foreach z (Tue-ent-Lpoint x)
   	(setq z (trans z 0 1))
   (command "DIMORDINATE" z "y" (list (+ (car z) kc) (cadr z) (caddr z)) )
   (command "DIMORDINATE" z "x" (list (car z) (+ (cadr z) kc) (caddr z)))

)
 )
 (setvar "osmode" oldos)
 (command "ucs" "p")
 (command "undo" "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

hihi nhoc pit mà, anh Tue cũng pit nhoc mới học nên nhoc thử nghịch xem chỉnh đc gì rèn luyện xíu ^^, đúng là ko cần bắt điểm, vì nhoc đoán khi bạn ấy khi mún chọn gốc tọa độ mới cần chế độ bắt điểm để xác định rõ điểm nào làm mốc cho chính xác nếu tắt thì thì nó bơ vơ wá, lsp mới của anh tuệ đã làm đc điều đó mà ko cần phải viết như nhoc ^^. Nhưng sao nhoc dùng thử thì chọn đối tượng nó ko nhận line, polyline hay arc, circle vậy anh tuệ nó báo thế lày

Command: DORR

undo Current settings: Auto = On, Control = All, Combine = Yes, Layer = Yes

Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]

<1>: be

Command:

Select objects: 0 found

 

Select objects: 0 found, 0 total

Select objects: error: bad argument type: lselsetp nil

Nhoc hem hỉu có sai sót gì trong cách sử dụng ko ^^

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

hihi nhoc pit mà, anh Tue cũng pit nhoc mới học nên nhoc thử nghịch xem chỉnh đc gì rèn luyện xíu ^^, đúng là ko cần bắt điểm, vì nhoc đoán khi bạn ấy khi mún chọn gốc tọa độ mới cần chế độ bắt điểm để xác định rõ điểm nào làm mốc cho chính xác nếu tắt thì thì nó bơ vơ wá, lsp mới của anh tuệ đã làm đc điều đó mà ko cần phải viết như nhoc ^^. Nhưng sao nhoc dùng thử thì chọn đối tượng nó ko nhận line, polyline hay arc, circle vậy anh tuệ nó báo thế lày

 

Nhoc hem hỉu có sai sót gì trong cách sử dụng ko ^^

À! Nhóc quét chọn toàn bộ đối tượng *LINE -> Chọn gốc tọa độ tương đối -> Lisp sẽ xuất toàn bộ ra đó

Lisp chạy với Layer "Visible line (Duong nhin thay)"

Nhóc có thể thay tên Layer phù hợp để chạy

  • 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

ah ra là anh Tue quy định layer ^^, nhoc đọc chưa hỉu kaka ^^, thui sữa lại xíu cho bạn í lun hen chơi lun layer hiện hành cho tiện, nhoc thêm vô arc, circle cho đủ bộ use tối đa hàm con anh Tue viết lun hen :D

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68893&pid=226493&st=0entry226493
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68893&pid=226458&st=0entry226458
(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))))
)
(if (wcmatch (Tue-dxf 0 e) "ARC,CIRCLE")
 (setq Lpoint (append Lpoint  (list (Tue-dxf 10 e)  )))
)
Lpoint
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

 (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
 (setq L (sslength ssg))
 (Repeat L
(setq ename (ssname ssg (setq L (1- L))))
(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
 )
)
(defun c:dorr (/ oldos ssd)
(vl-load-com)
(setq kc (getreal "\nNhap khoang cach mong mun <6.0>: "))
(if (= kc nil) (setq kc 6.0))
(setq oldos (getvar "osmode"))
(command "undo" "be")
 (setq ssd (Tue-ss-list (list (ssget '((0 . "*LINE,CIRCLE,ARC"))))))
(command "ucs" "m" (setq goc (getpoint "\n Chon goc toa do tuong doi :")))

 (setvar "osmode" 0)
 (foreach x ssd
(foreach z (Tue-ent-Lpoint x)
(setq z (trans z 0 1))
(command "DIMORDINATE" z "y" (list (+ (car z) kc) (cadr z) (caddr z)) )
(command "DIMORDINATE" z "x" (list (car z) (+ (cadr z) kc) (caddr z)))

)
 )
 (setvar "osmode" oldos)
 (command "ucs" "p")
 (command "undo" "e")
)

  • 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

Cảm ơn bác Bình đã nhiệt tình giúp đỡ. Em đã test thử lisp và gặp rắc rối sau.

- Khi đánh lệnh dimor cad yêu cầu Specify new origin point <0,0,0>: nhưng nó tắt mất chế độ truy bắt điểm mà bấm F3 cũng không được nên phải dùng lên OS mới thiết lập lại được

- Sau khi đặt được hệ trục tại vị trí cần thiết thì cad yêu cầu select object: sau đó mình chọn đối tượng thì cad bắt một điểm bất kì với dòng yêu cầu sau Specify leader endpoint or [Xdatum/Ydatum/Mtext/Text/Angle]: nhưng khi chọn x hoặc y enter thì nó không xuất được tọa độ mà nó nhảy sang vị trí khác nhưng khi bấm ESC thì nó đánh ra tọa độ và báo như này: cancel*

; error: Function cancelled

Specify leader endpoint or [Xdatum/Ydatum/Mtext/Text/Angle]:

Dimension text = 9.4137

Nhờ Bác hoàn thiện thêm và sửa các lỗi đó giúp em với. Bác có thể cho cad xuất ra cả X và Y sau đó em Autotay bớt cái thừa cũng được.

Với lại bác bình cho em hỏi một xíu trong trường hợp này là tọa độ tuyệt đối hay tương đối vậy. Nói thật em cứ lộn tùm phèo giữa tuyệt và tương bác ah. hihi chắc còn đi học chắc học lại vài lần nữa cho nhớ nhưng tiếc là không có được cơ hội đó nên có gì bác chỉ giúp em với nha. cảm ơn bác rất nhiều

 

PS:

Ngày mai mình phản hồi tiếp nha vì ở nhà ko có internet

:wacko:

Hề hề hề,

1/- Lisp của mình và cách sử dụng nó thì Chú nhóc đã giải thích khá rõ rùi. Mình không nói thêm mà chỉ giải thích một tí rằng đây là lisp nháp vì chưa hiểu hết yêu cầu của bạn chưa có chỉn chu lắm. Nếu bạn dùng được thì mới nói tới chuyện chỉnh sửa, chứ nếu chả đúng ý đồ thì bỏ luôn.

2/- Cái khái niệm tuyệt đối và tương đối thực ra do người dùng chọn mà thôi. Chú nhóc cũng đã nói rồi. Thực tế cách ghi kích thước này của bạn là ghi theo kích thước tương đối so với gốc tọa độ bạn chọn. Nhưng nếu bạn không chọn lại gốc tọa độ và sử dụng theo hệ tọa độ gốc của CAD (world) thì nó sẽ là tọa độ tuyệt đối. Trên bản vẽ bạn gửi thì bạn đã sử dụng hệ tọa độ mới do bạn xác định dựa vào đối tượng cho trước. Do vậy nếu hiểu theo hệ tọa độ của CAD thì nó là tọa độ tương đối so với gốc bạn chọn, Nhưng nếu bạn bỏ qua hệ tọa độ gốc của CAd (world) thì cũng có thể coi là tọa độ tuyệt đối trong hệ tọa độ bạn chọn.

Đó cũng là lý do mà mình xóa bài post trước của mình vì mỗi người có quyền quan niệm theo suy nghĩ của mình, miễn là không sai về bản chất vấn đề. Tuyệt đối hay tương đối luôn luôn phải có mốc chuẩn để nói bạn ạ.

3/- Việc học là việc cả đời, vấn đề là sử dụng cái mình học ra sao mới là cái cần bàn chứ còn học để cho oai, học để có bằng này cấp nọ đều chỉ là mảnh giấy lộn thôi. Cái quý của sự học là làm cho cái mình học được có ích cho xã hội chứ không phải là để cho bản thân mình oai hơn.

4/- Bác TueNV đã viết lisp khác với cái của mình, bạn dùng thử xem đã phù hợp chưa. Lisp của bác ấy có nhẽ tốt hơn do bác ấy tự động hóa nhiều hơn mình. Tuy nhiên có khi cái tự động ấy lại chả trùng ý bạn hay trong trường hợp bạn muốn lựa chọn điểm đặt kích thước cho nó "đẹp" thì phải chỉnh lại. Mỗi cái đều có những ý đồ riêng của người viết trong đó, Việc lựa chọn là của bạn và cố gắng chọn cái gì phù hợp nhất với mình. Việc sửa lisp của mình không phải là quá khó, song nếu lisp của bác TueNV đã đúng ý bạn thì việc sử của mình sẽ không cần thiết nữa đúng không???

 

Hề hề hề, mong bạn chớ có giậ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

ah ra là anh Tue quy định layer ^^, nhoc đọc chưa hỉu kaka ^^, thui sữa lại xíu cho bạn í lun hen chơi lun layer hiện hành cho tiện, nhoc thêm vô arc, circle cho đủ bộ use tối đa hàm con anh Tue viết lun hen :D

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68893&pid=226458&st=0entry226458
(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))))
)
(if (wcmatch (Tue-dxf 0 e) "ARC,CIRCLE")
 (setq Lpoint (append Lpoint  (list (Tue-dxf 10 e)  )))
)
Lpoint
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

 (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
 (setq L (sslength ssg))
 (Repeat L
(setq ename (ssname ssg (setq L (1- L))))
(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
 )
)
(defun c:dorr (/ oldos ssd)
(vl-load-com)
(setq kc 6.0)
(setq oldos (getvar "osmode"))
(command "undo" "be")
 (setq ssd (Tue-ss-list (list (ssget '((0 . "*LINE,CIRCLE,ARC"))))))
(command "ucs" "m" (setq goc (getpoint "\n Chon goc toa do tuong doi :")))

 (setvar "osmode" 0)
 (foreach x ssd
(foreach z (Tue-ent-Lpoint x)
(setq z (trans z 0 1))
(command "DIMORDINATE" z "y" (list (+ (car z) kc) (cadr z) (caddr z)) )
(command "DIMORDINATE" z "x" (list (car z) (+ (cadr z) kc) (caddr z)))

)
 )
 (setvar "osmode" oldos)
 (command "ucs" "p")
 (command "undo" "e")
)

Thực ra mình thêm đủ bộ ARC và CIRCLE rồi, có điều test với bản vẽ của bạn TruongAn thì dim bị nhảy (với ARC và CIRCLE). bạn ấy vẽ hình trên mặt ZX

  • 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

Wow! Có nhiều lựa chọn quá làm mình thực sự bối rối không biết nên test cái nào trước. Cảm ơn Anh Bình Anh Tuệ , nhoclangbat và ACE cadviet rất nhiều.

 

@ nhoclangbat: Cảm ơn bạn đã share tài liêu giờ mình đã nhớ đươc thế nào là tuyệt đối và tương đối mà lúc trước đã học trong CAD-CAM-CNC nhưng lâu quá không đụng đền nên quên hết.

Về phần lisp bạn nói đúng là mình thực sư chưa test kỹ lisp của anh Bình nên chưa sử dụng đúng ý của anh ấy viết tại lúc chiêu qua sắp tới giờ về nên mình vội quá.

@ Anh Bình: Sr anh vì hm qua em vội quá nên test chưa kĩ đã nói lisp anh bị lỗi. giờ hiểu cách dùng rồi thì lisp chạy ok nhưng đánh từng cái thì trong cad đã có lệnh DOR rồi anh ah. Ý em là mình chỉ quét một cái thì cad xuất ra tọa độ của những điểm có sự thay đổi về tọa độ. Cảm ơn anh

 

@ Anh Tuệ: Tuyệt vời lắm anh ah đúng như em cần nhưng em có thắc mắc xíu anh giúp em nha

- Em chưa hiểu ở chỗ này

"Thực ra mình thêm đủ bộ ARC và CIRCLE rồi, có điều test với bản vẽ của bạn TruongAn thì dim bị nhảy (với ARC và CIRCLE). bạn ấy vẽ hình trên mặt ZX"

Em không thấy dim nhảy với arc và circle hình em dựng trong mặt xy mà.

- Em muốn hỏi anh một điều nữa là mình có thể lập trình cho cad quét hết chi tiêt theo 2 phương X và Y nếu những điểm nào đồng tọa độ theo một phương thì không xuất ra nửa như vậy mình sẽ không mất thời gian chỉnh sửa lại dim. Nếu được anh giúp thêm phần này nha. Cảm ơn anh 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

Anh Tuệ ơi em test thử với arc và circle thì cad không nhận được anh ah.

Cho em hỏi thêm là mình có thể chỉnh chiều dài đoạn em khoanh màu xanh không

106444_capture_58.jpg

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

Bạn thử down lại lsp #9 nhoc sữa rùi đó ^^, có phần nhập khoảng cách cho nó dài ra :D

ko thì chạy xong autotay nắm kéo :D

Hi hi thank nhóc mình vừa mò mò trong lisp anh Tuệ giờ nó nhận được cả ARC và CIR luôn rồi còn phần nhập chiều dài thì để mình thử lisp của nhox xem thế nào.

Nếu có thêm phần màu xanh dưới đây nũa thì tốt quá nếu không chắc phải autotay thôi hii :

Em muốn hỏi anh một điều nữa là mình có thể lập trình cho cad quét hết chi tiêt theo 2 phương X và Y nếu những điểm nào đồng tọa độ theo một phương thì không xuất ra nửa như vậy mình sẽ không mất thời gian chỉnh sửa lại dim.

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

Wow! Có nhiều lựa chọn quá làm mình thực sự bối rối không biết nên test cái nào trước. Cảm ơn Anh Bình Anh Tuệ , nhoclangbat và ACE cadviet rất nhiều.

 

@ nhoclangbat: Cảm ơn bạn đã share tài liêu giờ mình đã nhớ đươc thế nào là tuyệt đối và tương đối mà lúc trước đã học trong CAD-CAM-CNC nhưng lâu quá không đụng đền nên quên hết.

Về phần lisp bạn nói đúng là mình thực sư chưa test kỹ lisp của anh Bình nên chưa sử dụng đúng ý của anh ấy viết tại lúc chiêu qua sắp tới giờ về nên mình vội quá.

@ Anh Bình: Sr anh vì hm qua em vội quá nên test chưa kĩ đã nói lisp anh bị lỗi. giờ hiểu cách dùng rồi thì lisp chạy ok nhưng đánh từng cái thì trong cad đã có lệnh DOR rồi anh ah. Ý em là mình chỉ quét một cái thì cad xuất ra tọa độ của những điểm có sự thay đổi về tọa độ. Cảm ơn anh

 

@ Anh Tuệ: Tuyệt vời lắm anh ah đúng như em cần nhưng em có thắc mắc xíu anh giúp em nha

- Em chưa hiểu ở chỗ này

"Thực ra mình thêm đủ bộ ARC và CIRCLE rồi, có điều test với bản vẽ của bạn TruongAn thì dim bị nhảy (với ARC và CIRCLE). bạn ấy vẽ hình trên mặt ZX"

Em không thấy dim nhảy với arc và circle hình em dựng trong mặt xy mà.

- Em muốn hỏi anh một điều nữa là mình có thể lập trình cho cad quét hết chi tiêt theo 2 phương X và Y nếu những điểm nào đồng tọa độ theo một phương thì không xuất ra nửa như vậy mình sẽ không mất thời gian chỉnh sửa lại dim. Nếu được anh giúp thêm phần này nha. Cảm ơn anh nhiều.

Trong file của bạn dựng trong mặt phẳng ZX

Bạn gõ lệnh UCS -> chuyển về W sẽ thấy

 

Command: ucs

Current ucs name: *NO NAME*

Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis] <World>: W

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

Em xử lý được rồi cảm ơn anh. Thế còn :

"mình có thể lập trình cho cad quét hết chi tiêt theo 2 phương X và Y nếu những điểm nào đồng tọa độ theo một phương thì không xuất ra ở những điểm tiếp theo như vậy mình sẽ không mất thời gian chỉnh sửa lại dim " """

có xử lý được không anh.

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

Em xử lý được rồi cảm ơn anh. Thế còn :

"mình có thể lập trình cho cad quét hết chi tiêt theo 2 phương X và Y nếu những điểm nào đồng tọa độ theo một phương thì không xuất ra ở những điểm tiếp theo như vậy mình sẽ không mất thời gian chỉnh sửa lại dim " """

có xử lý được không anh.

Bạn thử xem :


(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))))
)
(if (wcmatch (Tue-dxf 0 e) "ARC,CIRCLE")
 (setq Lpoint (append Lpoint  (list (Tue-dxf 10 e)  )))
)
Lpoint
)
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)

 (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
 (setq L (sslength ssg))
 (Repeat L
(setq ename (ssname ssg (setq L (1- L))))
(setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
 )
)
(defun c:dorr (/ oldos ssd)
(vl-load-com)

(setq kc 6.0)
(setq oldos (getvar "osmode"))
(command "undo" "be")
 (setq ssd (Tue-ss-list (list (ssget '((0 . "*LINE,CIRCLE,ARC"))))))
(command "ucs" "w")
(setq goc (getpoint "\n Chon goc toa do tuong doi :"))
 (setvar "osmode" 0)
 (command "zoom" "e")
 (foreach x ssd
(foreach z (Tue-ent-Lpoint x)
   	(if (null (ssget "c" z z '((0 . "DIMENSION")))) (progn
(command "DIMORDINATE" z "t" (rtos (- (cadr z) (cadr goc)) 2 0) "y" (list (+ (car z) kc) (cadr z) (caddr z)) )
(command "DIMORDINATE" z "t" (rtos (- (car z) (car goc)) 2 0)  "x" (list (car z) (+ (cadr z) kc) (caddr z)))
 ))
)
 )
 (command "zoom" "p")
 (setvar "osmode" oldos)
 (command "ucs" "p")
 (command "undo" "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

Anh Tuệ ơi ngoài phần lisp nhận được tất cả các layer, thêm ARC và CIR ra không làm thêm phần em đã hỏi ỏ trên được hả anh. Nói chung là lisp tốt rồi nhưng nều làm được phần đó nữa thì anh giúp em nha.

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

Anh Tuệ ơi ngoài phần lisp nhận được tất cả các layer, thêm ARC và CIR ra không làm thêm phần em đã hỏi ỏ trên được hả anh. Nói chung là lisp tốt rồi nhưng nều làm được phần đó nữa thì anh giúp em nha.

Đã làm ở bài số 18 rồi. Bạn chưa thử sao?

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

Em đã thử rồi anh ah kết quả như hình dưới. cad vẫn xuất ra các điểm đồng tọa độ. Anh xem file nhé

http://www.cadviet.c.../106444_abc.dwg

Có nghĩa là :

Nếu các điểm có cùng toạ độ X thì:

+ Nếu đã có 1 điểm đã ghi rồi thì các điểm còn lại không ghi nữa

+ Nếu chưa có điểm nào được ghi thì Lisp sẽ ghi toàn bộ điểm đó

Tương tự vậy cho các điểm có cùng toạ độ Y

Nếu như vậy thì mình nghĩ Lisp hoàn toàn làm được

 

Bạn vui lòng xác định chính xác yêu cầu để mình sửa code lisp cho phù hợp với y/c của bạ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

nhoc thấy ý tưởng này cũng hay hay ^^ chắc cũng giúp nhoc trong công việc 1 số trường hợp, chôm về xài cũng đc :D. Nhoc cũng góp ý xíu giúp hoàn thiện lsp, nhoc nghĩ ý bạn Truong_AAn chắc là vậy cũng giống anh Tue nói ko pit bạn í thế nào

104473_1111111111111.jpg

Những tọa độ gạch chéo là những tọa độ ko cần ghi, nói rõ hơn có thể là vầy:

-sau khi chọn trục tọa độ chọn hết đối tượng lsp sẽ ghi tọa độ theo hướng từ dưới lên trên và từ trái qua phải.

-Trục Y theo hướng từ dưới lên trên của đối tượng thì những điểm nào cùng tọa độ Y chỉ ghi Y cho điểm đầu tiên gặp điểm nào trước thì ghi điểm đó, các điểm còn lại theo hướng lên trên nữa ko cần ghi ^^

-Trục X cũng vậy từ trái qua phải gặp điểm nào đầu tiên trong tất cả đối tượng thì ghi X, các điểm tiếp theo ko cần ghi nữa ^^

Ps: ko pit í bạn Truong_AAn có giống nhoc không nhỉ :D,nhờ anh Tue giúp đỡ để lsp hoàn thiện hơ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

nhoc thấy ý tưởng này cũng hay hay ^^ chắc cũng giúp nhoc trong công việc 1 số trường hợp, chôm về xài cũng đc :D. Nhoc cũng góp ý xíu giúp hoàn thiện lsp, nhoc nghĩ ý bạn Truong_AAn chắc là vậy cũng giống anh Tue nói ko pit bạn í thế nào

 

Những tọa độ gạch chéo là những tọa độ ko cần ghi, nói rõ hơn có thể là vầy:

-sau khi chọn trục tọa độ chọn hết đối tượng lsp sẽ ghi tọa độ theo hướng từ dưới lên trên và từ trái qua phải.

-Trục Y theo hướng từ dưới lên trên của đối tượng thì những điểm nào cùng tọa độ Y chỉ ghi Y cho điểm đầu tiên gặp điểm nào trước thì ghi điểm đó, các điểm còn lại theo hướng lên trên nữa ko cần ghi ^^

-Trục X cũng vậy từ trái qua phải gặp điểm nào đầu tiên trong tất cả đối tượng thì ghi X, các điểm tiếp theo ko cần ghi nữa ^^

Ps: ko pit í bạn Truong_AAn có giống nhoc không nhỉ :D,nhờ anh Tue giúp đỡ để lsp hoàn thiện hơn ^^

Hề hề hề,

Bạn Truong_AAn và nhóc thử xài cái ni coi đã ưng cái ruột chưa nhé.


(defun c:dimor ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(command "undo" "be")
(setvar "osmode" 0)
(command "ucs" "n" "o" (getpoint))
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line,arc,circle")))))
(setq plst nil)
(foreach pl ssl
    (if (= (cdr (assoc 0 (entget pl))) "*POLYLINE")
        (setq plst (append plst (acet-geom-vertex-list pl)))         
    )
    (if (= (cdr (assoc 0 (entget pl))) "LINE")
        (setq plst (append plst (list (trans (cdr (assoc 10 (entget pl))) 0 1) (trans (cdr (assoc 11 (entget pl))) 0 1))))
    )
    (if (or (= (cdr (assoc 0 (entget pl))) "ARC") (= (cdr (assoc 0 (entget pl))) "CIRCLE"))
        (setq plst  (append plst (list (cdr (assoc 10 (entget pl))) ) ))
    )
)
(setq plst (vl-sort plst '(lambda (x y) (< (car x) (car y)))))
(setq xlst nil, ylst nil)
    (foreach ver plst
          (if (not (member (car ver) xlst))
              (progn
                  (command "dimordinate" ver "x" (list (car ver) (- (cadr ver) 6)) "")
                  (setq xlst (append xlst (list (car ver))))
              )
          )
          (if (not (member (cadr ver) ylst))
              (progn
                  (command "dimordinate" ver "y" (list (- (car ver) 6) (cadr ver)) "")
                  (setq ylst (append ylst (list (cadr ver))))
              )
          )
    )

(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)

 

Lưu ý rằng cái sự dài hay ngắn của đường dẫn kích thước là do người dùng chọn nhé. Ở trong lisp thì mình để cố định là 6. Nếu muốn thì hãy tự thay thê chỗ này.

Chúc mọi người cưới to.

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

Đăng nhập để thực hiện theo  

×