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  
conghoa

Lệnh offset đặc biệt

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

Tue_NV    3.841

Các bạn có thể viết giúp lisp ofset liên tục khi nhập vào khoảng cách: 10,2@20,50 không ?

Cám ơn!

"ofset liên tục khi nhập vào khoảng cách: 10,2@20,50"

 

thì số 10,2@20,50 nghĩa là gì hở bạn??

Bạn vui lòng nói rõ

  • 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

Ví dụ như sau:

1.Chọn đường thẳng

2.Chọn hướng ofset

3.Nhập vào khoảng cách: 10,2@20,50

Kết quả tạo ra 4 đối tượng cách đối tượng gốc là: 10,30,50,100

Cám ơn!

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
(defun C:dof(/ lstDis obj)
(setq lstDIS '(9 10 -15))
(while (setq obj (car (entsel "\nSelect object:")))
(foreach dis lstDIS
(vla-offset (vlax-ename->vla-object obj) dis)
)
)
(princ)
)

Code này mình sưu tầm được nó cho phép Off như trên. Nhưng chưa hiện thị nhập giá trị từ bàn phím và xử lý có khoảng cách @

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
Doan Van Ha    2.676

Lisp ofset liên tục khi nhập vào khoảng cách.


 

;Doan Van Ha - CADViet.com - Ngay 04/05/2013
;Chuc nang: Offset lien tuc theo string nhap vao. VD: str = "10,2@20,50" => Offest: 10, 30, 50, 100.
(defun C:HA(/ lst ent)
 (vl-load-com)
 (setq str (getstring "\Nhap bieu thuc gia tri offset: "))
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
 (while (setq ent (car (entsel "\nChon doi tuong de offset: ")))
  (foreach dis lst
   (vla-offset (vlax-ename->vla-object ent) dis)
   (setq ent (entlast))))
 (princ))
(defun LM:str->lst (str del / pos)
 (if (setq pos (vl-string-search del str))
  (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
  (list str)))
(defun HA:str->lst (str del / lst1)
 (setq lst (LM:str->lst str del))
 (if (= (length lst) 1)
  (mapcar 'atof lst)
  (repeat (atoi (car lst))
   (setq lst1 (cons (atof (cadr lst)) lst1)))))
  • 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 nhiều

Sau khi mò mẫm về cơ bản mình sử lý được 70%, còn cái vụ tách @ hàm hay thật

(defun C:dof(/ lstDis obj cc)
;(setq lstDIS '(9 10 -15))
;(setq lstDIS (str->lst "9 10 15 " " ")) 
(setq cc (getstring (strcat"\nNhap cac khoang cach:")))
(setq lstDIS (str->lst  cc ",")) 
;(while (setq obj (car (entsel "\nSelect object:")))
(setq obj (car (entsel "\nSelect object:")))
(setq kc 0)
(foreach dis lstDIS
'(vla-offset (vlax-ename->vla-object obj) dis)
(setq kc (+ kc (atof dis)))
(vla-offset (vlax-ename->vla-object obj) kc)
)
;)
(princ)
)

(defun Str->lst ( str del / pos )
(vl-remove ","
	(if (setq pos (vl-string-search del str))
    	(cons (substr str 1 pos) (Str->lst (substr str (+ pos 1 (strlen del))) del))
    	(list str)
	)
)
)
@ ĐVH có thể giải thích giúp đoạn code sau ?

(setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))

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
Tue_NV    3.841

 

(defun C:dof(/ lstDis obj)
(setq lstDIS '(9 10 -15))
(while (setq obj (car (entsel "\nSelect object:")))
(foreach dis lstDIS
(vla-offset (vlax-ename->vla-object obj) dis)
)
)
(princ)
)

Code này mình sưu tầm được nó cho phép Off như trên. Nhưng chưa hiện thị nhập giá trị từ bàn phím và xử lý có khoảng cách @

 

Thêm 1 đoạn code nữa :

 

 
(defun c:olt(/ str)
  (vl-load-com)
  (defun Str_Split(str sym / lst i)
  ;write by Tue_NV
  (while (setq i (vl-string-search sym str 0))
    (setq lst (append lst (list (substr str 1 i)))
      i (+ i 1 (strlen sym))  str (substr str i (strlen str) ) )
  )
 (append lst (list (substr str 1 (strlen str))))
)
  (setq str (getstring "Chuoi Offset \"#,#@#,#\"  : "))
  (setq dt (car(entsel "\ndoi tuong can offset :")))
(foreach y
    (apply 'append
       (mapcar '(lambda(x / a lst) 
  (if (wcmatch x "*#`@#*")
    (progn (setq a (last (STR_SPLIT x "@"))) (Repeat (atoi x) (setq lst (append lst (list a)))) ) (list x) ))
(STR_SPLIT str ",")) )  
    (vla-offset (vlax-ename->vla-object dt) (atof y))
    (setq dt (entlast))
)
)
  • 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 nhiều. Nhưng có lẽ cần phải bổ sung thêm tính năng Pick chọn hướng offset. (nghĩa là pick chọn điểm về 1 phía của đối tượng chọn)

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
Tue_NV    3.841

Cám ơn bác nhiều. Nhưng có lẽ cần phải bổ sung thêm tính năng Pick chọn hướng offset. (nghĩa là pick chọn điểm về 1 phía của đối tượng chọn)

 Đây ban

 

 
(defun c:olt(/ st dt str lst-num)
  (setvar "cmdecho" 0)
  (vl-load-com)
  (defun Str_Split(str sym / lst i)
  ;write by Tue_NV
  (while (setq i (vl-string-search sym str 0))
    (setq lst (append lst (list (substr str 1 i)))
      i (+ i 1 (strlen sym))  str (substr str i (strlen str) ) )
  )
 (append lst (list (substr str 1 (strlen str))))
)
  (setq str (getstring "Chuoi Offset \"#,#@#,#\"  : "))
  (setq dt (car(entsel "\ndoi tuong can offset :")) pt (getpoint "\nHuong Offset :")) 
(Repeat (length (setq lst-num (reverse 
       (apply 'append
        (mapcar '(lambda(x / a lst) 
     (if (wcmatch x "*#`@#*")
          (progn (setq a (atof (last (STR_SPLIT x "@")))) (Repeat (atoi x) (setq lst (append lst (list a)))) ) (list (atof x)) ))
(STR_SPLIT str ",")) ) )  ) )  
     (command "offset" (apply '+ lst-num) dt "_non" pt "e")
     (setq lst-num (cdr lst-num))
)
(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

Không ý mình dạng như thế nghĩa là như sau:

1.Chọn đối tượng Block

2.Nhập vào khoảng cách: 10,2@50,...

3.Sau đó cái Block sẽ được copy theo số lần

Với cái lisp HA ở trên mình đang tìm xem có hàm Vla-Copy không để thay thế xử lý chắc là ổn ?

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
Tue_NV    3.841

Không ý mình dạng như thế nghĩa là như sau:

1.Chọn đối tượng Block

2.Nhập vào khoảng cách: 10,2@50,...

3.Sau đó cái Block sẽ được copy theo số lần

Với cái lisp HA ở trên mình đang tìm xem có hàm Vla-Copy không để thay thế xử lý chắc là ổn ?

 

4. Copy mà không có hướng (góc) copy thì làm sao mà cóp?

Cóp khác với Offset nhé.

 

Cái này mình nghĩ bạn tự xây dựng được. Đã có hướng tách chuỗi để lấy chiều dài rồi, Nhập thêm cái hướng để copy nữa là được. Bạn tự làm xem 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
Tue_NV    3.841

Đúng rồi! Bạn dùng vla-copy, chú ý nó có 3 tham số nhé.

 

vla-copy làm gì có tới 3 tham số lận bác? (1 tham số thô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

Mình mới thêm nhưng chưa rõ cú pháp như sau có chuẩn không?

(defun C:cop()
 (vl-load-com)
 (setq str (getstring  "\nNh\U+1EADp bi\U+1EC3u th\U+1EE9c gi\U+00E1 tr\U+1ECB Offet <10,2@30,50,...>: "))
   (setq ent   (car (entsel "n\chon block"))
	 p1    (cdr (assoc 10 (entget dt)))
	 p2    (getpoint p1 "\nVao diem den: ")
   );Setq
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
 ;(while (setq ent (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset: ")))
  (foreach dis lst
   (setq newobj (vla-copy (vlax-ename->vla-object ent)))
   (vla-move newobj p1 p2)
   (setq ent (entlast)));)
 (princ))

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
Doan Van Ha    2.676

 

Mình mới thêm nhưng chưa rõ cú pháp như sau có chuẩn không?

(defun C:cop()
 (vl-load-com)
 (setq str (getstring  "\nNh\U+1EADp bi\U+1EC3u th\U+1EE9c gi\U+00E1 tr\U+1ECB Offet <10,2@30,50,...>: "))
   (setq ent   (car (entsel "n\chon block"))
	 p1    (cdr (assoc 10 (entget dt)))
	 p2    (getpoint p1 "\nVao diem den: ")
   );Setq
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
 ;(while (setq ent (car (entsel "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Offset: ")))
  (foreach dis lst
   (setq newobj (vla-copy (vlax-ename->vla-object ent)))
   (vla-move newobj p1 p2)
   (setq ent (entlast)));)
 (princ))

3 chỗ sai:

1). Nhầm: ent mà ghi là dt.

2). p1 và p2 phải ở trong hàm vlax-3d-point

3). p2 chỉ để lấy hướng copy là p1->p2 chứ không phải là khoảng cách để copy.

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

3 chỗ sai:

1). Nhầm: ent mà ghi là dt.

2). p1 và p2 phải ở trong hàm vlax-3d-point

3). p2 chỉ để lấy hướng copy là p1->p2 chứ không phải là khoảng cách để copy.

các ý 1,3 đã hiểu. Ý 2 chưa rõ lắm

Mình code thử lại

(defun C:cop()
 (vl-load-com)
 (setq str (getstring  "\nNh\U+1EADp bi\U+1EC3u th\U+1EE9c gi\U+00E1 tr\U+1ECB Offet <10,2@30,50,...>: "))
   (setq ent   (car (entsel "n\chon block"))
	 p1    (cdr (assoc 10 (entget ent)))
   );Setq
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
  (foreach dis lst
   (setq newobj (vla-copy ent))
   (command ".copy" newobj "" p1 (polar p1 0 dis))
   (setq ent (entlast)));)
 (princ))

Nó báo lỗi nchon block; error: bad argument type: VLA-OBJECT <Entity name: 7ef95610>

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
Doan Van Ha    2.676

Hàm vla-copy hoặc vla-move thì đối tượng là vla-object.

Lệnh copy thì đối tượng là entity hoặc ssget. Bạn sai ở đây vì newobj là vla-object.

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àm vla-copy hoặc vla-move thì đối tượng là vla-object.

Lệnh copy thì đối tượng là entity hoặc ssget. Bạn sai ở đây vì newobj là vla-object.

Mình có tham khảo ở đây

http://www.afralisp.net/archive/methods/list/copy_method.htm

   (setq newobj (vla-copy (vlax-ename->vla-object ent)))
   (setq p2 (list (+ dis (car p1)) (cadr p1)))
   (vla-move newobj p1 p2)

Nhưng báo sai cấu trúc ?

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 sự góp ý của mọi người. Mình đã thử thấy ok. Đang cố thêm nốt cái đoạn chọn hướng copy nữa là ok :)

;=======================================================================
(defun C:cop()
 (vl-load-com)
 (setq str (getstring  "\n Nh\U+1EADp bi\U+1EC3u th\U+1EE9c gi\U+00E1 tr\U+1ECB Offet <10,2@30,50,...>: "))
   (setq ent   (car (entsel "n \chon block"))
	 p1    (cdr (assoc 10 (entget ent)))
   );Setq
 (setq lst (apply 'append (mapcar '(lambda(x) (HA:str->lst x "@")) (LM:str->lst str ","))))
  (foreach dis lst
   (setq newobj (vla-copy (vlax-ename->vla-object ent)))
   (setq p2 (list (+ dis (car p1)) (cadr p1)))
   (vla-move newobj (vlax-3d-point p1) (vlax-3d-point p2))
   (setq ent (entlast)));)
 (princ))
;=======================================================================

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
ad.pham234    7

các bác cho em hỏi 1 chút xíu được ko ạ e líp oo này rất hay rồi nhưng nhờ các bác chỉnh hộ 1 tí nữa là ok .em muốn khi opset sang 2 bên thì đối tượng mới ở 1 layer mới không trùng với layer gốc đc ko các bác. các bác chỉnh giúp em với !http://www.cadviet.com/upfiles/5/144248_oo.lsp

  • Vote giảm 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

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  

×