Lệnh offset đặc biệt

[NguyenNgocSon 43]

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!

[Tue_NV 3.912]

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õ

[NguyenNgocSon 43]

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!

[NguyenNgocSon 43]

(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 @

[Doan Van Ha 3.181]

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

[NguyenNgocSon 43]

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

[Tue_NV 3.912]

 

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

[NguyenNgocSon 43]

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)

[Tue_NV 3.912]

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

[NguyenNgocSon 43]

Cám ơn. Giả sử bây giờ đối tượng là Block thì việc xử lý có phức tạp không ?

Thân !

[Doan Van Ha 3.181]

Offset block? Trong block có nhiều thứ thì offset ra răng?

[NguyenNgocSon 43]

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 ?

[Tue_NV 3.912]

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.

[Doan Van Ha 3.181]

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

[Tue_NV 3.912]

Đú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)

[Doan Van Ha 3.181]

Ủa, sao kỳ vậy! Obj+pt1+pt2 mà!

[Tue_NV 3.912]

Ủa, sao kỳ vậy! Obj+pt1+pt2 mà!

 

Bác ôn lại bài nhé!  :lol: 

[Doan Van Ha 3.181]

:D Mới ôn thi xong, 0 tham số, srr nhầm em MU >> NNSơn phải kết hợp vla-copy và vl-move.

[NguyenNgocSon 43]

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

[Doan Van Ha 3.181]

 

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.

[NguyenNgocSon 43]

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>

[Doan Van Ha 3.181]

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.

[NguyenNgocSon 43]

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 ?

[NguyenNgocSon 43]

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))
;=======================================================================

[ad.pham234 20]

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