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

[Nhờ chỉnh sửa]lisp cắt 1 đoạn thẳng

Bởi t031285 , trong AutoLisp

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

t031285    1

t031285
Đã đăng

Lisp này e down từ diễn đàn,lisp này có tác dụng cắt 1 đoạn thẳng trong 1 đường thẳng và có cho ta lựa chọn thuộc tính của đoạn thẳng này.Nhưng khi muốn biến đoạn thẳng này thành nét đứt thì có 1 bất tiện e nhờ các bác sửa giúp như sau.

Trong bản vẽ có hệ số LTS là 1,

1.Có 1 đoạn thẳng là nét đứt và có LTS là 50 chẳng hạn.

2.Có 1 đường thẳng.

E dùng lisp này để cắt 1 đoạn thẳng trong đường thẳng 2 này và biến đoạn thẳng này thành đoạn thẳng 1 là nét đứt nhưng hệ số LTS chỉ là 1 theo bản vẽ chứ không theo LTS của đoạn thẳng 1 là 50,Nhờ các bác sửa giùm sao cho đoạn thẳng này thành nét đứt có LTS là 50 theo đúng đoạn thẳng đã chọn.Chân thành cảm ơn.

(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
 (vl-load-com)
 (command "undo" "be")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))          	; Get Old values
 (mapcar 'setvar vl '(545 0 0))
 (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi :"))   )
(progn
     	(setq cObj (vlax-ename->vla-object Ent)
	pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
	pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
 	(if (> (vlax-curve-getParamAtPoint cObj pt1)
 	(vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp) )     
 	(command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
 	(if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
(command "change" ent "" "p" "LA" (lcurr) "")
(progn
  (command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
  (command "change" (entlast) "" "p" "LA" (lcurr) "")
  )
)
 	(redraw ent 4)
 	(mapcar 'setvar vl ov) ; reset Sys Vars
 	(command "undo" "e")
 	)
(alert "Khong hop le !"))
 (princ))
;
(defun lcurr(/ e)
	(setq str (getstring t "\n Nhap ten layer hoac Enter de pick vao doi tuong :"))
(if (= str "")
(progn
(while (null (setq e (entsel "\n pick vao doi tuong :"))))
(setvar "clayer" (cdr(assoc 8 (entget(car e)))))
)
(progn
(while (null (tblsearch "layer" str))
(setq str (getstring t "\n Nhap lai ten layer :"))
)
(setvar "clayer" 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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Lisp này e down từ diễn đàn,lisp này có tác dụng cắt 1 đoạn thẳng trong 1 đường thẳng và có cho ta lựa chọn thuộc tính của đoạn thẳng này.Nhưng khi muốn biến đoạn thẳng này thành nét đứt thì có 1 bất tiện e nhờ các bác sửa giúp như sau.

Trong bản vẽ có hệ số LTS là 1,

1.Có 1 đoạn thẳng là nét đứt và có LTS là 50 chẳng hạn.

2.Có 1 đường thẳng.

E dùng lisp này để cắt 1 đoạn thẳng trong đường thẳng 2 này và biến đoạn thẳng này thành đoạn thẳng 1 là nét đứt nhưng hệ số LTS chỉ là 1 theo bản vẽ chứ không theo LTS của đoạn thẳng 1 là 50,Nhờ các bác sửa giùm sao cho đoạn thẳng này thành nét đứt có LTS là 50 theo đúng đoạn thẳng đã chọn.Chân thành cảm ơn.

(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
 (vl-load-com)
 (command "undo" "be")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))          	; Get Old values
 (mapcar 'setvar vl '(545 0 0))
 (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi :"))   )
(progn
     	(setq cObj (vlax-ename->vla-object Ent)
pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
 	(if (> (vlax-curve-getParamAtPoint cObj pt1)
 	(vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp) )    
 	(command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
 	(if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
(command "change" ent "" "p" "LA" (lcurr) "")
(progn
  (command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
  (command "change" (entlast) "" "p" "LA" (lcurr) "")
  )
)
 	(redraw ent 4)
 	(mapcar 'setvar vl ov) ; reset Sys Vars
 	(command "undo" "e")
 	)
(alert "Khong hop le !"))
 (princ))
;
(defun lcurr(/ e)
(setq str (getstring t "\n Nhap ten layer hoac Enter de pick vao doi tuong :"))
(if (= str "")
(progn
(while (null (setq e (entsel "\n pick vao doi tuong :"))))
(setvar "clayer" (cdr(assoc 8 (entget(car e)))))
)
(progn
(while (null (tblsearch "layer" str))
(setq str (getstring t "\n Nhap lai ten layer :"))
)
(setvar "clayer" str)
)
)
)

Hề hề hề,

Thú thực là đọc cái lisp bạn post chẳng hề dễ dàng chút nào.

Sau khi đọc kỹ mình thấy trong lisp đâu có việc chuyển LTS theo đối tượng mẫu đâu mà bạn bảo sửa????

Lisp chỉ có chuyển layer của đối tượng break về layer mẫu mà thôi. Do vậy nếu LT của đối tượng là bylayer thì nó sẽ theo LT của layer đó, còn nếu không phải là bylaer thì nó sẽ chả chuyển gì sốt.

Việc bạn muốn nó chuyển thành LTS của đối tượng mẫu có nhẽ không khó, nhưng bạn lưu ý rằng khi chuyển ltscale thì tất cả các line trên bản vẻ của bạn sẽ đều bì chuyển đó. Điều này có nhẽ bạn sẽ không thích đâu.

Còn nếu bạn vẫn muốn thì đơn giản là bạn dùng lệnh ltscale của Cad là sẽ Ok đâu cần tới lisp làm chi cho nó thêm ..... đợi chờ....

  • 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

ketxu    2.983

ketxu
Đã đăng

Hì. Put linetypescale cho từng đối tượng thì không ảnh hưởng tới các đối tượng khác bác ạ ^^

  • 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

t031285    1

t031285
Đã đăng

Hì. Put linetypescale cho từng đối tượng thì không ảnh hưởng tới các đối tượng khác bác ạ ^^

Đúng bác ah,e chỉ muốn lấy linetypescale của đoạn thẳng 1 cho đoạn thẳng vừa cắt.

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

ketxu    2.983

ketxu
Đã đăng

.....

(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
 (vl-load-com)
 (command "undo" "be")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))       	; Get Old values
 (mapcar 'setvar vl '(545 0 0))
 (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi :"))   )
(progn
  	(setq cObj (vlax-ename->vla-object Ent)
 pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
 pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
  (if (> (vlax-curve-getParamAtPoint cObj pt1)
  (vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp))    
  (command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
(command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
  (setq ent1 (vlax-ename->vla-object (car (entsel "\nDoi tuong mau :"))))
(if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
 (setq ent (vlax-ename->vla-object ent))
 (setq ent (vlax-ename->vla-object (entlast)))
)
(vla-put-layer ent (vla-get-layer ent1))
(vla-put-LinetypeScale ent (vla-get-Linetypescale ent1))
  (redraw ent 4)
  (mapcar 'setvar vl ov) ; reset Sys Vars
  (command "undo" "e")
  )
(alert "Khong hop le !"))
 (princ))

  • 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

hugo007    1

hugo007
Đã đăng

Các bác cho e hỏi,khi e sử dụng 1 lisp,lisp này vẫn cho ra kết quả mình muốn,nhưng khi thực hiện xong thì dòng command hiện câu:

error: bad argument type: lentityp #<VLA-OBJECT IAcadLine

Mong các bác giải thích và chỉ e cách khắc phục.Thanks.

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Các bác cho e hỏi,khi e sử dụng 1 lisp,lisp này vẫn cho ra kết quả mình muốn,nhưng khi thực hiện xong thì dòng command hiện câu:

error: bad argument type: lentityp #<VLA-OBJECT IAcadLine

Mong các bác giải thích và chỉ e cách khắc phục.Thanks.

Hề hề hề,

Cứ theo ngu ý của mình thì chắc hẳn trong lisp của bạn có một dòng code nào đó sử dụng sai tên biến, nhưng cái dòng code này lại chả liên quan gì tới cái kết quả mà bạn cần và có nhẽ nó nằm ở cuối lisp của bạn nên khi chạy lisp xong, lisp trả về giá trị của biến cuối cùng (nếu không có hàm (princ) ở cuối lisp) và thế là nó báo lỗi.

Cách sửa là bạn hãy kiểm tra lại xem dòng code lỗi ấy nó ở đâu và vô hiệu hóa nó là Ok. Hoặc củ chuối hơn là bạn nhét thằng (princ) vào cuối lisp để nó thoát luôn mà chẳng màng chi tới cái biến cuối nữa.

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

hugo007    1

hugo007
Đã đăng

Hề hề hề,

Cứ theo ngu ý của mình thì chắc hẳn trong lisp của bạn có một dòng code nào đó sử dụng sai tên biến, nhưng cái dòng code này lại chả liên quan gì tới cái kết quả mà bạn cần và có nhẽ nó nằm ở cuối lisp của bạn nên khi chạy lisp xong, lisp trả về giá trị của biến cuối cùng (nếu không có hàm (princ) ở cuối lisp) và thế là nó báo lỗi.

Cách sửa là bạn hãy kiểm tra lại xem dòng code lỗi ấy nó ở đâu và vô hiệu hóa nó là Ok. Hoặc củ chuối hơn là bạn nhét thằng (princ) vào cuối lisp để nó thoát luôn mà chẳng màng chi tới cái biến cuối nữa.

Hề hề hề,...

Có princ ở cuối bác ah.e gửi lisp này lên các bác xem giúp:

 
(defun c:brk(/ cobj ent ov pt1 pt2 tmp vl str); brk -> Break Curve
 (vl-load-com)
 (command "undo" "be")
 (setq vl '("osmode" "orthomode" "cmdecho") ; Sys Var list
ov (mapcar 'getvar vl))   	 ; Get Old values
 (mapcar 'setvar vl '(545 0 0))
 (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(not (redraw ent 3))
(setq pt1 (getpoint "\nDiem dau :"))
(setq pt2 (getpoint "\nDiem cuoi :"))   )
(progn
   (setq cObj (vlax-ename->vla-object Ent)
 pt1 (vlax-curve-getClosestPointto cObj (trans pt1 1 0))
 pt2 (vlax-curve-getClosestPointto cObj (trans pt2 1 0)))
  (if (> (vlax-curve-getParamAtPoint cObj pt1)
  (vlax-curve-getParamAtPoint cObj pt2))
(setq tmp pt1 pt1 pt2 pt2 tmp))   
  (command "._break" ent "_non" (trans pt2 0 1) "_non" (trans pt2 0 1))
(command "._break" ent "_non" (trans pt1 0 1) "_non" (trans pt1 0 1))
  (setq ent1 (vlax-ename->vla-object (car (entsel "\nDoi tuong mau :"))))
(if (equal pt1 (vlax-curve-getStartPoint cObj) 0.001)
 (setq ent (vlax-ename->vla-object ent))
 (setq ent (vlax-ename->vla-object (entlast)))
)
(vla-put-layer ent (vla-get-layer ent1))
(vla-put-LinetypeScale ent (vla-get-Linetypescale ent1))
  (redraw ent 4)
  (mapcar 'setvar vl ov) ; reset Sys Vars
  (command "undo" "e")
  )
(alert "Khong hop le !"))
 (princ))

Chân thành cảm ơn trước.

  • 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

ketxu    2.983

ketxu
Đã đăng

Tại sao bạn không gửi ngay tại Topic bạn down file , gửi bản vẽ lúc thao tác.....??

Diễn đàn có nhiều lisp lắm rồi, lúc tổng hợp cứ thấy quote đi code lại những code giống nhau quả thật rất bất tiện.

Mình chuyển những bài này vào topic đó, hi vọng lần sau bạn rút kinh nghiệm

http://www.cadviet.com/forum/index.php?showtopic=54237&hl=&fromsearch=1

  • 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

hugo007    1

hugo007
Đã đăng

Tại sao bạn không gửi ngay tại Topic bạn down file , gửi bản vẽ lúc thao tác.....??

Diễn đàn có nhiều lisp lắm rồi, lúc tổng hợp cứ thấy quote đi code lại những code giống nhau quả thật rất bất tiện.

Mình chuyển những bài này vào topic đó, hi vọng lần sau bạn rút kinh nghiệm

http://www.cadviet.c...l=&fromsearch=1

Bác xem giúp e lỗi này luôn với.Thanks.

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
Có princ ở cuối bác ah.e gửi lisp này lên các bác xem giúp:

Chân thành cảm ơn trước.

Hề hề hề,

Cái lisp này mình đoán có nhẽ là của bác ketxu thì phải.

Mình không rành lắm về các hàm (vla- ......)

Tuy nhiên đọc thì thấy và hiểu ra lờ mờ rằng cái lỗi là do hàm sau

 

(redraw ent 4)

Hàm này nhận đối số là entity name chứ không phải vla-object.

Vậy nên bạn cần phải bổ sung:

(setq ent (vlax-vla-object->ename ent))

vào phía trên dòng code (redraw ent 4).

Chúc bạn vui.

PS:

Do lần trước bạn nói lisp vẫn chạy ra kết quả nên mình không rõ mới đoán mò, thực chất lisp này chạy sẽ không hết do gập lỗi và nó ngừng tại đây. bằng chứng là nếu bạn undo sẽ thấy CAD nhắc bạn phải thêm lệnh undo end.

bạn nên chú ý điều này khi check lisp nhé.

  • 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

minhngockt    5

minhngockt
Đã đăng

Nhờ các bác viết hộ em lisp cắt đường thẳng, em có một đường thẳng line hay pline có kích thước bất kỳ, bây giờ em muốn cắt đường thẳng đó đi 1 đoạn, chỉ cần pick chuột vào đầu hoặc cuối đoạn thẳng đó nó sẽ cắt đi giá trị mình cần cắt, và giá trị mình cần cắt đó sẽ giữ nguyên khi cần cắt đường thẳng tiếp theo. Em cảm ơn các bác rất 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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

Nhờ các bác viết hộ em lisp cắt đường thẳng, em có một đường thẳng line hay pline có kích thước bất kỳ, bây giờ em muốn cắt đường thẳng đó đi 1 đoạn, chỉ cần pick chuột vào đầu hoặc cuối đoạn thẳng đó nó sẽ cắt đi giá trị mình cần cắt, và giá trị mình cần cắt đó sẽ giữ nguyên khi cần cắt đường thẳng tiếp theo. Em cảm ơn các bác rất nhiều

Đây bạn!

;Doan Van Ha - CADViet.com - Ngay 04-03-2012
;Muc dich: Cat 1 phan Line/Pline tinh tu diem dau/cuoi.
(defun C:HA( / osm cmd kc pt ss obj pd pc len)
(command "undo" "be")
(setq osm (getvar "osmode") cmd (getvar "cmdecho"))
(vl-load-com)
(setq kc (getreal "\nNhap khoang cach can cat bot: "))
(while
 (and
  (setvar "osmode" 1)
  (setq pt (getpoint "\nChon diem dau hoac cuoi cua Line/Pline: ")))
 (setvar "osmode" 0)
 (setq ss (ssget pt '((0 . "*LINE"))))
 (setq obj (vlax-ename->vla-object (ssname ss 0)))
 (setq pd (vlax-curve-getStartPoint obj))
 (setq pc (vlax-curve-getEndPoint obj))
 (setq len (vlax-curve-getDistAtPoint obj pc))
 (if (< kc len)
  (if (equal pt pd 1E-8)
(progn
(setq p (vlax-curve-getPointAtDist obj kc))
(command "break" (ssname ss 0) p pd))
(progn
(setq p (vlax-curve-getPointAtDist obj (- len kc)))
(command "break" (ssname ss 0) p pc)))
  (princ "\nKhoang cach lon hon chieu dai.")))
(setvar "osmode" osm) (setvar "cmdecho" cmd)
(command "undo" "end")
(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

ketxu    2.983

ketxu
Đã đăng

:)

Chỉ cần thế này thôi :

(defun c:cat()(command "lengthen" "DE"))

Có nghĩa là hãy dùng giá trị âm trong lệnh Lengthen -> Delta nếu muốn cắt, và + nếu muốn thêm. Giá trị này tất nhiên sẽ được CAD lưu giữ cho lần tiếp theo

  • Vote tăng 3

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    3.180

Doan Van Ha
Đã đăng

:)

Chỉ cần thế này thôi :

(defun c:cat()(command "lengthen" "DE"))

Có nghĩa là hãy dùng giá trị âm trong lệnh Lengthen -> Delta nếu muốn cắt, và + nếu muốn thêm. Giá trị này tất nhiên sẽ được CAD lưu giữ cho lần tiếp theo

Ồ! Thằng "lengthen" này còn có chức năng hay ghê mà lâu nay đâu có biết. Thank Ket 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

xuanquoc    3

xuanquoc
Đã đăng

 

các cao nhân có thể giúp e lisp cắt 1 line ( pline) nhập giá trị hoặc click thì tạo thành 2 line (pline) và 2 đoạn này hở nha 100 và nối chông lên nhau theo giá trị chỉ định ko ạ. XIN CẢM ƠN CÁC CAO NHÂN

Vào lúc 4/3/2012 tại 11:31, ketxu đã nói:

:)

Chỉ cần thế này thôi :

  


(defun c:cat()(command "lengthen" "DE"))
 

 

Có nghĩa là hãy dùng giá trị âm trong lệnh Lengthen -> Delta nếu muốn cắt, và + nếu muốn thêm. Giá trị này tất nhiên sẽ được CAD lưu giữ cho lần tiếp theo

 

ANH.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

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
Về Đầu Trang AutoLisp
×