Đến nội dung


Hình ảnh
- - - - -

[Đã xong] Lisp thêm đỉnh cho PL


  • Please log in to reply
23 replies to this topic

#1 beba

beba

    biết zoom

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

Đã gửi 06 June 2011 - 09:12 AM

Cảm ơn anh Ketxu đã nhiệt tình giúp đỡ
Thực ra là em chưa biết gì nhiều về lisp,
em chỉ sửa thử cái lisp có sẳn nên có lỗi gì em cũng không hiểu,
thôi em nói rõ để anh dễ giúp

Em làm cắt ngang địa hình bằng Nova trên Cad 14 nên phải thường tạo thêm nhiều đỉnh mới trên PLine
Bình thường em phải làm bằng lệnh :

Command: pe
PEDIT Select polyline or [Multiple]:
Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]: e

Enter a vertex editing option
[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: i

Specify location for new vertex:

Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"
không phải gõ "e" -> "i"

Cái lisp Nut cũ anh sửa, em load Nut -> vẽ Line . chỉ tạo được 1 đỉnh trên Line đó muốn tạo thêm đỉnh nửa nó thoát ra luôn
  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 06 June 2011 - 09:31 AM

Cảm ơn anh Ketxu đã nhiệt tình giúp đỡ
Thực ra là em chưa biết gì nhiều về lisp,
em chỉ sửa thử cái lisp có sẳn nên có lỗi gì em cũng không hiểu,
thôi em nói rõ để anh dễ giúp

Em làm cắt ngang địa hình bằng Nova trên Cad 14 nên phải thường tạo thêm nhiều đỉnh mới trên PLine
Bình thường em phải làm bằng lệnh :

Command: pe
PEDIT Select polyline or [Multiple]:
Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]: e

Enter a vertex editing option
[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: i

Specify location for new vertex:

Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"
không phải gõ "e" -> "i"

Cái lisp Nut cũ anh sửa, em load Nut -> vẽ Line . chỉ tạo được 1 đỉnh trên Line đó muốn tạo thêm đỉnh nửa nó thoát ra luôn

Vì bạn không chịu đọc bài mình nói

Mình sửa lại như thế này, làm mỗi lần 1 điểm, nếu bạn thích giống CAD thì bỏ phần pause "x" "" đi.

Cái theo yêu cầu Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"
không phải gõ "e" -> "i"


Update code : cho phép bạn chèn liên tiếp, đến bao giờ ấn Esc thì thôi!
(defun C:pe(/ ent) (setq ent (car(entsel "\n Chon doi tuong"))) 
(cond ((=(cdadr (entget ent)) "LINE")
(command "pedit" ent "" "E" )
(while (< 0 (getvar "CMDACTIVE")) (command "I" pause))
)
((=(cdadr (entget ent)) "LWPOLYLINE")
(command "pedit" ent "E")
(while (< 0 (getvar "CMDACTIVE")) (command "I" pause))
)
))

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1360 (rất tốt)

Đã gửi 29 June 2011 - 04:25 PM

Cảm ơn anh Ketxu đã nhiệt tình giúp đỡ
Thực ra là em chưa biết gì nhiều về lisp,
em chỉ sửa thử cái lisp có sẳn nên có lỗi gì em cũng không hiểu,
thôi em nói rõ để anh dễ giúp

Em làm cắt ngang địa hình bằng Nova trên Cad 14 nên phải thường tạo thêm nhiều đỉnh mới trên PLine
Bình thường em phải làm bằng lệnh :

Command: pe
PEDIT Select polyline or [Multiple]:
Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]: e

Enter a vertex editing option
[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: i

Specify location for new vertex:

Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"
không phải gõ "e" -> "i"

Cái lisp Nut cũ anh sửa, em load Nut -> vẽ Line . chỉ tạo được 1 đỉnh trên Line đó muốn tạo thêm đỉnh nửa nó thoát ra luôn

Mình cũng có 1 cái đây.
-Tên lệnh. TDPL:
-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.
(Defun C:tdpl ( )   
(command "undo" "be")
(chonduong)
(chidienthem)
(taothemnut)
(while
(chidienthem)
(taothemnut)
)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chidienthem ( )
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemthem (getpoint "\nDiem muon tao nut tren duong dan:"))
(setq daidendiemthem (vlax-curve-getDistAtPoint doituongt diemthem))
(cond
((= daidendiemthem nil) (princ "\nDiem chon khong thuoc doi tuong muon them, chon lai:") (chidienthem))
((/= daidendiemthem nil)
)
)
(setvar "osmode" luubatdiem)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduong ( )
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
(while
(null doituong1)
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
)
(chonduongd)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduongd ( )
(setq doituongt (car doituong1))
(setq doituong (entget doituongt))
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun taothemnut ( )
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq sodinh (cdr (assoc 90 doituong)))
(setq Rec (acet-geom-vertex-list doituongt))
(setq ttd 0)
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
(while (< daidendiemdinh daidendiemthem)
(setq ttd (1+ ttd))
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
)
(command "pedit" doituongt "E")
(while (< 0 (getvar "CMDACTIVE"))
(repeat (fix (fix (- ttd 1)))
(command "n"))
(command "I" diemthem "x" ""))
(setvar "osmode" luubatdiem)
(Princ)
(Princ)
)


*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:
  • 1

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 29 June 2011 - 09:31 PM

Mình cũng có 1 cái đây.
-Tên lệnh. TDPL:
-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:

Hề hề hề,
Chào các bác, mình cũng có cái ni mới mần thử, đem ra đây khoe của một tí, các bác chớ giận hỉ.


(defun c:advt (/ oldos enpl enp1 obj p pp plst n)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 545 )
(setq enpl (car (entsel "\n Chon polyline can them vertext "))
obj (vlax-ename->vla-object enpl)
p (getpoint "\n Pick point de them vertext")
)
(while p
(setq pp (vlax-curve-getclosestpointto obj p))
(if (equal p pp 0.001)
(progn
(setq p pp)
(command "break" enpl p "@")
(setq enp1 (entlast)
plst (acet-geom-vertex-list enp1)
n (vlax-curve-getendparam obj)
)
(command "erase" enp1 "")
(command "pedit" enpl "e")
(repeat (fix n)
(command "n")
)
(foreach pt (cdr plst)
(command "i" pt "n")
)
(command "x" "")
)
(progn
(setq n (vlax-curve-getendparam obj))
(command "pedit" enpl "e")
(repeat (fix n)
(command "n")
)
(command "i" p "x" "")
)
)
(setq p nil)
(setq p (getpoint "\n Chon diem ke tiep "))
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 29 June 2011 - 11:16 PM

Ket có up 1 cái tương tự kích vào phân đoạn nào thì thêm ở đó ở diễn đàn r, giờ tìm cũng không thấy ^^ Ts bác Bình :wub:
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 tvgtyb08

tvgtyb08

    biết vẽ spline

  • Members
  • PipPip
  • 92 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 03 July 2011 - 03:06 PM

Mình cũng có 1 cái đây.
-Tên lệnh. TDPL:
-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

(Defun C:tdpl ( )   
(command "undo" "be")
(chonduong)
(chidienthem)
(taothemnut)
(while
(chidienthem)
(taothemnut)
)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chidienthem ( )
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemthem (getpoint "\nDiem muon tao nut tren duong dan:"))
(setq daidendiemthem (vlax-curve-getDistAtPoint doituongt diemthem))
(cond
((= daidendiemthem nil) (princ "\nDiem chon khong thuoc doi tuong muon them, chon lai:") (chidienthem))
((/= daidendiemthem nil)
)
)
(setvar "osmode" luubatdiem)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduong ( )
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
(while
(null doituong1)
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
)
(chonduongd)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduongd ( )
(setq doituongt (car doituong1))
(setq doituong (entget doituongt))
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun taothemnut ( )
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq sodinh (cdr (assoc 90 doituong)))
(setq Rec (acet-geom-vertex-list doituongt))
(setq ttd 0)
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
(while (< daidendiemdinh daidendiemthem)
(setq ttd (1+ ttd))
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
)
(command "pedit" doituongt "E")
(while (< 0 (getvar "CMDACTIVE"))
(repeat (fix (fix (- ttd 1)))
(command "n"))
(command "I" diemthem "x" ""))
(setvar "osmode" luubatdiem)
(Princ)
(Princ)
)


*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:


Cái của bá Duy hình như ko được đâu?

[you] thử chưa?
  • 0

#7 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 21 July 2011 - 11:15 AM

Ket có up 1 cái tương tự kích vào phân đoạn nào thì thêm ở đó ở diễn đàn r, giờ tìm cũng không thấy ^^ Ts bác Bình :wub:

Đây rồi. Source nguồn của Gilles Chanteau, ket thêm tí muối,lisp áp dụng cho cả Pline có arc và Width thay đổi
http://www.youtube.com/watch?v=31dreoLuj6A
Lệnh vtx.
Update :
Ấn u hoặc Ctrl Z để undo trong quá trình làm việc
Cảm ơn bác Thaistreetz ^^

(defun c:vtx () ;main
(vl-load-com)
(vl-cmdf "undo" "Begin")
(initget "t b T B")
(setq ans (getkword "Th\U+00EAm hay b\U+1EDBt vextex ? [T / B]"))
(cond ((or(= ans "t")(= ans "T")(not ans))(addvtx))
(T (delvtx))
)
(vl-cmdf "undo" "end")
)

(defun addvtx (/ err AcDoc pl ob pk pa ap typ org
ucs ocs pt sp ep co no p1 p2 pt ce
a1 a2 bu pw wi nw
)
(setq m:err *error*
*error* err
AcDoc (vla-get-activeDocument (vlax-get-acad-object))
os (getvar "osmode")

)

(while
(or(initget "u")
(setq pl (entsel "\nCh\U+1ECDn ph\U+00E2n \U+0111o\U+1EA1n mu\U+1ED1n add th\U+00EAm vertex : ")))
(cond ((or(= pl "u")(= pl "U"))(vl-cmdf "undo" "back"))
(T
(setq ob (vlax-ename->vla-object (car pl)))
(setq typ (vla-get-Objectname ob))
(if (or (= typ "AcDbPolyline")
(and (member typ '("AcDb2dPolyline" "AcDb3dPolyline"))
(= 0 (vla-get-Type ob))
)
)
(progn
(vl-cmdf "undo" "mark")
(setq pk
(if (= typ "AcDb3dPolyline")
(trans (osnap (cadr pl) "_nea") 1 0)
(vlax-curve-getClosestPointToProjection
ob
(trans (cadr pl) 1 0)
(mapcar '-
(trans (getvar "VIEWDIR") 1 0)
(trans '(0 0 0) 1 0)
)
)
)
)
(setq ap (/ (* (getvar "APERTURE")
(getvar "VIEWSIZE")
)
(cadr (getvar "SCREENSIZE"))
)
)
(if (= typ "AcDbPolyline")
(setq co (split-list (vlax-get ob 'Coordinates) 2))
(setq co (split-list (vlax-get ob 'Coordinates) 3))
)
(cond
((equal pk (vlax-curve-getStartPoint ob) ap)
(setq pa 0)
(if (= (vla-get-Closed ob) :vlax-false)
(setq sp (vlax-curve-getStartPoint ob)
ep nil
)
(setq ep nil
sp nil
)
)
)
((equal pk (vlax-curve-getEndPoint ob) ap)
(setq pa (1- (length co)))
(if (= (vla-get-Closed ob) :vlax-false)
(setq ep (vlax-curve-getEndPoint ob)
sp nil
)
(setq ep nil
sp nil
)
)
)
(T
(setq pa (atoi (rtos (vlax-curve-getParamAtPoint ob pk) 2))
ep nil
sp nil
)
)
)
(if (and (/= typ "AcDb3dPolyline")
(or
(not (equal (trans '(0 0 1) 1 0 T)
(setq no (vlax-get ob 'Normal))
1e-9
)
)
(and (= typ "AcDbPolyline")
(/= 0 (vla-get-Elevation ob))
)
(and (= typ "AcDb2dPolyline") (/= 0 (caddar co)))
)
)
(progn
(setq ucs (vla-add
(vla-get-UserCoordinateSystems AcDoc)
(vlax-3d-point (setq org (getvar "UCSORG")))
(vlax-3d-point (mapcar '+ org (getvar "UCSXDIR")))
(vlax-3d-point (mapcar '+ org (getvar "UCSYDIR")))
"addvtxUCS"
)
ocs (vla-add
(vla-get-UserCoordinateSystems AcDoc)
(vlax-3d-Point
(setq org (vlax-curve-getStartPoint ob))
)
(vlax-3d-Point
(mapcar '+ org (trans '(1 0 0) no 0))
)
(vlax-3d-Point
(mapcar '+ org (trans '(0 1 0) no 0))
)
"addvtxOCS"
)
)
(vla-put-activeUCS AcDoc ocs)
)
)
(if (setq
pt
(getpoint (trans (vlax-curve-getPointAtParam ob pa) 0 1)
"\nPick \U+0111i\U+1EC3m th\U+00EAm vertex : "
)
)
(progn
(and ep (setq pa (- (length co) 2)))
(if (/= typ "AcDb3dPolyline")
(progn
(setq p1 (trans (vlax-curve-getPointAtParam ob pa) 0 no)
pt (trans pt 1 no)
p2 (trans (vlax-curve-getPointAtParam ob (1+ pa))
0
no
)
)
(cond
((and ep (/= 0 (vla-getBulge ob pa)))
((lambda (a)
(setq
bu
(list (cons (1+ (fix pa)) (/ (sin a) (cos a))))
)
)
(/
(- (angle p2 pt)
(+ (angle p2 p1)
(* 2 (atan (vla-getBulge ob pa)))
pi
)
)
2.0
)
)
)
((and sp (/= 0 (vla-getBulge ob pa)))
((lambda (a)
(setq
bu (list (cons 0 (/ (sin a) (cos a))))
)
)
(/
(- (+ (angle p1 p2)
(* -2 (atan (vla-getBulge ob pa)))
pi
)
(angle p1 pt)
)
2.0
)
)
)
(T
(setq
ce ((lambda (mid1 mid2)
(inters mid1
(polar mid1
(+ (angle p1 pt) (/ pi 2))
1.0
)
mid2
(polar mid2
(+ (angle pt p2) (/ pi 2))
1.0
)
nil
)
)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))
p1
pt
)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))
pt
p2
)
)
)
(if (or (= 0 (vla-getBulge ob pa)) (null ce))
(setq a1 0.0
a2 0.0
)
(if (< pi
(ang<2pi (- (angle pt p2) (angle p1 pt)))
(* 2 pi)
)
(setq a1 (- (ang<2pi (- (angle ce p1) (angle ce pt)))
)
a2 (- (ang<2pi (- (angle ce pt) (angle ce p2)))
)
)
(setq a1 (ang<2pi (- (angle ce pt) (angle ce p1)))
a2 (ang<2pi (- (angle ce p2) (angle ce pt)))
)
)
)
(setq bu
(list (cons pa (/ (sin (/ a1 4.0)) (cos (/ a1 4.0))))
(cons (1+ (fix pa))
(/ (sin (/ a2 4.0)) (cos (/ a2 4.0)))
)
)
)
)
)
(vla-getWidth ob pa 'sw 'ew)
(cond
((equal pk (vlax-curve-getStartPoint ob) ap)
(setq
pw (+ sw
(/ (* (distance p1 pt) (- ew sw))
(+ (distance pt p1) (distance p1 p2))
)
)
)
)
((equal pk (vlax-curve-getEndPoint ob) ap)
(setq
pw (+ sw
(/ (* (distance p1 p2) (- ew sw))
(+ (distance pt p2) (distance p1 p2))
)
)
)
)
(T
(setq
pw (+ sw
(/ (* (distance p1 pt) (- ew sw))
(+ (distance p1 pt) (distance pt p2))
)
)
)
)
)
(setq wi (list (list pa sw pw) (list (1+ pa) pw ew))
nw (1+ pa)
)
(repeat (- (fix (vlax-curve-getEndParam ob)) (1+ pa))
(vla-getWidth ob nw 'sw 'ew)
(setq wi (cons (list (setq nw (1+ nw)) sw ew) wi))
)
)
)
(cond
((= typ "AcDbPolyline")
(setq pt (list (car pt) (cadr pt)))
)
((= typ "AcDb3dPolyline") (setq pt (trans pt 1 0)))
)
(or sp (setq pa (1+ pa)))
(cond
(sp (setq co (cons pt co)))
(ep (setq co (append co (list pt))))
(T
(setq co (append (sublist co 0 pa)
(cons pt (sublist co pa nil))
)
)
)
)
(or
(= typ "AcDb3dPolyline")
(while (<= (setq pa (1+ pa)) (vlax-curve-getEndParam ob))
(setq bu (cons (cons pa (vla-getBulge ob (1- pa))) bu))
)
)
(vlax-put ob 'Coordinates (apply 'append co))
(or (= typ "AcDb3dPolyline")
(and
(mapcar '(lambda (x) (vla-setBulge ob (car x) (cdr x)))
bu
)
(mapcar '(lambda (x)
(vla-setWidth ob (car x) (cadr x) (caddr x))
)
wi
)
)
)
(and ucs (vla-put-activeUCS AcDoc ucs))
(vla-EndUndoMark AcDoc)
)
)
)
(progn
(alert "Ch\U+1ECDn sai \U+0111\U+1ED1i t\U+01B0\U+1EE3ng!")
(exit)
)
);end if check type
);end T
);end cond

);end while
(and ocs (vla-delete ocs) (setq ocs nil))
(setq *error* m:err
m:err nil
)
(princ)
)

(defun DelVtx (/ err os pt ent typ plst par blst n wlst)
(vl-load-com)
(setq m:err *error*
*error* err
os (getvar "OSMODE")
)
(setvar "OSMODE" 1)
(while
(or (initget "u")
(setq pt
(getpoint
"\nCh\U+1ECDn vertex c\U+1EA7n x\U+00F3a :"
)
))
(cond ((or(= pt "u")(= pt "U"))(vl-cmdf "undo" "back"))
(T
(if (and
(setq ent (ssget pt
'((-4 . "<OR")
(0 . "LWPOLYLINE")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<NOT")
(-4 . "&")
(70 . 118)
(-4 . "NOT>")
(-4 . "AND>")
(-4 . "OR>")
)
)
)
(setq ent (vlax-ename->vla-object (ssname ent 0)))
(setq typ (vla-get-ObjectName ent))
)
(if
(and
(setq plst (if (= typ "AcDbPolyline")
(split-list (vlax-get ent 'Coordinates) 2)
(split-list (vlax-get ent 'Coordinates) 3)
)
)
(< 2 (length plst))
)
(progn
(vl-cmdf "undo" "mark")
(setq pt (trans pt 1 0)
par (cond
((equal pt (vlax-curve-getStartPoint ent) 1e-9)
0
)
((equal pt (vlax-curve-getEndPoint ent) 1e-9)
(1- (length plst))
)
(T
(atoi (rtos (vlax-curve-getParamAtPoint ent pt) 2)
)
)
)
blst nil
wlst nil
n 0
)
(if (/= typ "AcDb3dPolyline")
(progn
(repeat (length plst)
(if (/= n par)
(setq
blst
(cons (cons (length blst) (vla-getBulge ent n))
blst
)
)
)
(setq n (1+ n))
)
(if (/= 0 par)
(progn
(vla-getWidth ent (1- par) 'swid1 'ewid1)
(vla-getWidth ent par 'swid2 'ewid2)
(setq wlst (cons (list (1- par) swid1 ewid2) wlst))
)
)
(repeat
(- (setq n (1- (fix (vlax-curve-getEndParam ent))))
par
)
(vla-getWidth ent n 'swid 'ewid)
(setq
wlst (cons (list (setq n (1- n)) swid ewid) wlst)
)
)
)
)
(vlax-put ent
'Coordinates
(apply 'append (vl-remove (nth par plst) plst))
)
(or (= typ "AcDb3dPolyline")
(and
(mapcar '(lambda (x) (vla-setBulge ent (car x) (cdr x)))
blst
)
(mapcar '(lambda (x)
(vla-setWidth ent (car x) (cadr x) (caddr x))
)
wlst
)
)
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(progn
(alert "\nKh\U+00F4ng th\U+1EC3 x\U+00F3a \U+0111\U+01B0\U+1EE3c, Pline n\U+00E0y ch\U+1EC9 c\U+00F3 1 ph\U+00E2n \U+0111o\U+1EA1n!")
(exit)
)
)
(progn
(alert "Ch\U+1ECDn sai \U+0111\U+1ED1i t\U+01B0\U+1EE3ng!")
(exit)
)
)
);endT
);end cond
)
(setvar "OSMODE" os)
(setq *error* m:err
m:err nil
)
(princ)
)

;;; SUBLIST Return a sub-list
;;;
;;; Arguments
;;; lst : a list
;;; start : start index for the sub-list (first item = 0)
;;; leng : sub-list length (or nil)
;;;
;;; Examples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(repeat leng
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)

;; SPLIT-LIST Split a list into sub-lists
;; Arguments
;; - lst : the list to be splited
;; - num : an integer, the number of items of sub-lists
;; Examples :
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))

(defun split-list (lst n)
(if lst
(cons (sublist lst 0 n)
(split-list (sublist lst n nil) n)
)
)
)

;;; ANG<2PI
;; Transform any angle (in radians) into its equivalent between 0 and 2*pi

(defun ang<2pi (ang)
(if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
)
)


(defun err (msg)
(if (or
(= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setvar "OSMODE" os)
(setq *error* m:err
m:err nil
)
)

  • 8

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#8 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 21 July 2011 - 12:29 PM

Thật tuyệt vời đó ketxu à. Hii. Vote vài cái nữa. Hiii
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#9 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 23 July 2011 - 08:37 AM

code trên rất hay. nhưng có 1 nhuợc điểm cũng rất... dở là không cho undo trong quá trình thêm hoặc bớt đỉnh ketxu ạ. cách thức undo như khi vẽ 1 pline, có 1 đỉnh nào đó mình pick sai thì gõ U, bỏ đỉnh đó đi để vẽ lại í. Bạn có thể tham khảo code này của mình để sửa nó ngon hơn.

;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz
(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)
(if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®­êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))
(progn
(vl-cmdf "undo" "begin")
(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")
(progn
(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
(setvar "PLINETYPE" 1)
(vl-cmdf "convert" "P" "S" PL "")
(setvar "PLINETYPE" PLSTLAST)
);progn
);if
(setq PLs (ssadd PL (ssadd)))
(while (progn
(sssetfirst nil PLs)
(initget 128 "u")
(setq PTa (getpoint (TCVN3-Unicode "\nPick ®Ønh cÇn thªm ")))
(if (= PTa "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) PTa))
(if (/= PTa "u")
(progn
(vl-cmdf "undo" "mark")
(setq PT (vlax-curve-getPointatParam PL (setq n (fix (vlax-curve-getParamatPoint PL (vlax-curve-getClosestPointto PL (setq PTa (trans PTa 1 0))))))))
(setq Lst nil)
(if (= n 0)
(progn
(setq Lstpt (reverse(acet-geom-pline-point-list PL nil))
PL1 (makeLWPolyline lstpt nil nil nil nil nil nil))
(if (= (fix (vlax-curve-getParamatPoint PL1 (vlax-curve-getClosestPointto PL1 PTa))) (- (length Lstpt) 1))
(mapcar '(lambda (x)
(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
(cons x (cons (list 10 (car PTa) (cadr PTa)) Lst))
(cons x Lst))))
(entget PL))
(mapcar '(lambda (x)
(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
(cons x Lst))))
(entget PL)))
(entdel PL1))
(mapcar '(lambda (x)
(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
(cons x Lst)))) (entget PL)))
(entmod (reverse Lst))))
);while
(sssetfirst)
(if DKCV (vl-cmdf "CONVERTPOLY" "H" wp "")))
(prompt (TCVN3-Unicode "\n§èi t­îng kh«ng ph¶i Polyline ")));if
(vl-cmdf "undo" "end")
(princ)
);end
;;; remove vertext into Polyline and LWPolyline
;;; copyright 2010 by Gia_Bach
;;; Edited 2010 by thaistreetz
(defun c:edv (/ removenth bulges coords ent idx param pt DKCV PLSTLAST)
(defun removenth (n lst / i rtn)
(setq i -1)
(foreach x lst (if (/= n (setq i (1+ i))) (setq rtn (cons x rtn))))
(reverse rtn))
(vl-cmdf "undo" "begin")
(while (progn
(initget 128 "u")
(setq ent (entsel (TCVN3-Unicode "\nChän ®Ønh Pline cÇn xãa: ")))
(if (= ent "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) ent))
(if (and (/= ent "u") (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
(progn
(vl-cmdf "undo" "Mark")
(princ (setq pt (osnap (cadr ent) "near")))
(if (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
(progn
(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
(setvar "PLINETYPE" 1)
(vl-cmdf "convert" "P" "S" (car ent) "")
(setvar "PLINETYPE" PLSTLAST)))
(setq ent (vlax-ename->vla-object (car ent))
param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0))
coords (vlax-get ent 'coordinates) idx -1 bulges nil)
(repeat (/ (length coords) 2) (setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges)))
(setq bulges (removenth param (reverse bulges)))
(repeat 2 (setq coords (removenth (* 2 param) coords)))
(vlax-put ent 'coordinates coords)
(setq idx -1)
(foreach bulge bulges (vla-setbulge ent (setq idx (1+ idx)) bulge))))
);while
(if DKCV (vl-cmdf "CONVERTPOLY" "H" ent ""))
(vl-cmdf "undo" "end")
(princ)
);end
(defun TCVN3-Unicode (stsua / index stdich chuht chusua tapsua)
(if (= (getvar "acadver") "16.1s (LMS Tech)") stsua (progn
(setq tapsua
(list (cons "µ" "\U+00E0")(cons "Ì" "\U+00E8")(cons "ß" "\U+00F2")(cons "ï" "\U+00F9")
(cons "¸" "\U+00E1")(cons "Ð" "\U+00E9")(cons "ã" "\U+00F3")(cons "ó" "\U+00FA")
(cons "¶" "\U+1EA3")(cons "Î" "\U+1EBB")(cons "á" "\U+1ECF")(cons "ñ" "\U+1EE7")
(cons "·" "\U+00E3")(cons "Ï" "\U+1EBD")(cons "â" "\U+00F5")(cons "ò" "\U+0169")
(cons "¹" "\U+1EA1")(cons "Ñ" "\U+1EB9")(cons "ä" "\U+1ECD")(cons "ô" "\U+1EE5")
(cons "©" "\U+00E2")(cons "ª" "\U+00EA")(cons "«" "\U+00F4")(cons "­" "\U+01B0")
(cons "Ç" "\U+1EA7")(cons "Ò" "\U+1EC1")(cons "å" "\U+1ED3")(cons "õ" "\U+1EEB")
(cons "Ê" "\U+1EA5")(cons "Õ" "\U+1EBF")(cons "è" "\U+1ED1")(cons "ø" "\U+1EE9")
(cons "È" "\U+1EA9")(cons "Ó" "\U+1EC3")(cons "æ" "\U+1ED5")(cons "ö" "\U+1EED")
(cons "É" "\U+1EAB")(cons "Ô" "\U+1EC5")(cons "ç" "\U+1ED7")(cons "÷" "\U+1EEF")
(cons "Ë" "\U+1EAD")(cons "Ö" "\U+1EC7")(cons "é" "\U+1ED9")(cons "ù" "\U+1EF1")
(cons "¨" "\U+0103")(cons "×" "\U+00EC")(cons "¬" "\U+01A1")(cons "ú" "\U+1EF3")
(cons "»" "\U+1EB1")(cons "Ý" "\U+00ED")(cons "ê" "\U+1EDD")(cons "ý" "\U+00FD")
(cons "¾" "\U+1EAF")(cons "Ø" "\U+1EC9")(cons "í" "\U+1EDB")(cons "û" "\U+1EF7")
(cons "¼" "\U+1EB3")(cons "Ü" "\U+0129")(cons "ë" "\U+1EDF")(cons "ü" "\U+1EF9")
(cons "½" "\U+1EB5")(cons "Þ" "\U+1ECB")(cons "ì" "\U+1EE1")(cons "þ" "\U+1EF5")
(cons "Æ" "\U+1EB7")(cons "®" "\U+0111")(cons "î" "\U+1EE3")(cons "¦" "\U+01AF")
(cons "¢" "\U+00C2")(cons "§" "\U+0110")(cons "¤" "\U+00D4")(cons "¥" "\U+01A0")
(cons "¡" "\U+0102")(cons "£" "\U+00CA")))
(setq index 1 stdich "")
(repeat (strlen stsua)
(setq chuht (substr stsua index 1)
index (1+ index)
chusua (cond ((assoc chuht tapsua) (cdr (assoc chuht tapsua))) (t chuht))
stdich (strcat stdich chusua)))
stdich)))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end

  • 3

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#10 thanhduan2407

thanhduan2407

    biết lệnh adcenter

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

Đã gửi 23 July 2011 - 08:54 AM

code trên rất hay. nhưng có 1 nhuợc điểm cũng rất... dở là không cho undo trong quá trình thêm hoặc bớt đỉnh ketxu ạ. cách thức undo như khi vẽ 1 pline, có 1 đỉnh nào đó mình pick sai thì gõ U, bỏ đỉnh đó đi để vẽ lại í. Bạn có thể tham khảo code này của mình để sửa nó ngon hơn.


;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz
(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)
(if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®­êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))
(progn
(vl-cmdf "undo" "begin")
(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")
(progn
(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
(setvar "PLINETYPE" 1)
(vl-cmdf "convert" "P" "S" PL "")
(setvar "PLINETYPE" PLSTLAST)
);progn
);if
(setq PLs (ssadd PL (ssadd)))
(while (progn
(sssetfirst nil PLs)
(initget 128 "u")
(setq PTa (getpoint (TCVN3-Unicode "\nPick ®Ønh cÇn thªm ")))
(if (= PTa "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) PTa))
(if (/= PTa "u")
(progn
(vl-cmdf "undo" "mark")
(setq PT (vlax-curve-getPointatParam PL (setq n (fix (vlax-curve-getParamatPoint PL (vlax-curve-getClosestPointto PL (setq PTa (trans PTa 1 0))))))))
(setq Lst nil)
(if (= n 0)
(progn
(setq Lstpt (reverse(acet-geom-pline-point-list PL nil))
PL1 (makeLWPolyline lstpt nil nil nil nil nil nil))
(if (= (fix (vlax-curve-getParamatPoint PL1 (vlax-curve-getClosestPointto PL1 PTa))) (- (length Lstpt) 1))
(mapcar '(lambda (x)
(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
(cons x (cons (list 10 (car PTa) (cadr PTa)) Lst))
(cons x Lst))))
(entget PL))
(mapcar '(lambda (x)
(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
(cons x Lst))))
(entget PL)))
(entdel PL1))
(mapcar '(lambda (x)
(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
(cons x Lst)))) (entget PL)))
(entmod (reverse Lst))))
);while
(sssetfirst)
(if DKCV (vl-cmdf "CONVERTPOLY" "H" wp "")))
(prompt (TCVN3-Unicode "\n§èi t­îng kh«ng ph¶i Polyline ")));if
(vl-cmdf "undo" "end")
(princ)
);end
;;; remove vertext into Polyline and LWPolyline
;;; copyright 2010 by Gia_Bach
;;; Edited 2010 by thaistreetz
(defun c:edv (/ removenth bulges coords ent idx param pt DKCV PLSTLAST)
(defun removenth (n lst / i rtn)
(setq i -1)
(foreach x lst (if (/= n (setq i (1+ i))) (setq rtn (cons x rtn))))
(reverse rtn))
(vl-cmdf "undo" "begin")
(while (progn
(initget 128 "u")
(setq ent (entsel (TCVN3-Unicode "\nChän ®Ønh Pline cÇn xãa: ")))
(if (= ent "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) ent))
(if (and (/= ent "u") (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
(progn
(vl-cmdf "undo" "Mark")
(princ (setq pt (osnap (cadr ent) "near")))
(if (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
(progn
(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
(setvar "PLINETYPE" 1)
(vl-cmdf "convert" "P" "S" (car ent) "")
(setvar "PLINETYPE" PLSTLAST)))
(setq ent (vlax-ename->vla-object (car ent))
param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0))
coords (vlax-get ent 'coordinates) idx -1 bulges nil)
(repeat (/ (length coords) 2) (setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges)))
(setq bulges (removenth param (reverse bulges)))
(repeat 2 (setq coords (removenth (* 2 param) coords)))
(vlax-put ent 'coordinates coords)
(setq idx -1)
(foreach bulge bulges (vla-setbulge ent (setq idx (1+ idx)) bulge))))
);while
(if DKCV (vl-cmdf "CONVERTPOLY" "H" ent ""))
(vl-cmdf "undo" "end")
(princ)
);end
(defun TCVN3-Unicode (stsua / index stdich chuht chusua tapsua)
(if (= (getvar "acadver") "16.1s (LMS Tech)") stsua (progn
(setq tapsua
(list (cons "µ" "\U+00E0")(cons "Ì" "\U+00E8")(cons "ß" "\U+00F2")(cons "ï" "\U+00F9")
(cons "¸" "\U+00E1")(cons "Ð" "\U+00E9")(cons "ã" "\U+00F3")(cons "ó" "\U+00FA")
(cons "¶" "\U+1EA3")(cons "Î" "\U+1EBB")(cons "á" "\U+1ECF")(cons "ñ" "\U+1EE7")
(cons "·" "\U+00E3")(cons "Ï" "\U+1EBD")(cons "â" "\U+00F5")(cons "ò" "\U+0169")
(cons "¹" "\U+1EA1")(cons "Ñ" "\U+1EB9")(cons "ä" "\U+1ECD")(cons "ô" "\U+1EE5")
(cons "©" "\U+00E2")(cons "ª" "\U+00EA")(cons "«" "\U+00F4")(cons "­" "\U+01B0")
(cons "Ç" "\U+1EA7")(cons "Ò" "\U+1EC1")(cons "å" "\U+1ED3")(cons "õ" "\U+1EEB")
(cons "Ê" "\U+1EA5")(cons "Õ" "\U+1EBF")(cons "è" "\U+1ED1")(cons "ø" "\U+1EE9")
(cons "È" "\U+1EA9")(cons "Ó" "\U+1EC3")(cons "æ" "\U+1ED5")(cons "ö" "\U+1EED")
(cons "É" "\U+1EAB")(cons "Ô" "\U+1EC5")(cons "ç" "\U+1ED7")(cons "÷" "\U+1EEF")
(cons "Ë" "\U+1EAD")(cons "Ö" "\U+1EC7")(cons "é" "\U+1ED9")(cons "ù" "\U+1EF1")
(cons "¨" "\U+0103")(cons "×" "\U+00EC")(cons "¬" "\U+01A1")(cons "ú" "\U+1EF3")
(cons "»" "\U+1EB1")(cons "Ý" "\U+00ED")(cons "ê" "\U+1EDD")(cons "ý" "\U+00FD")
(cons "¾" "\U+1EAF")(cons "Ø" "\U+1EC9")(cons "í" "\U+1EDB")(cons "û" "\U+1EF7")
(cons "¼" "\U+1EB3")(cons "Ü" "\U+0129")(cons "ë" "\U+1EDF")(cons "ü" "\U+1EF9")
(cons "½" "\U+1EB5")(cons "Þ" "\U+1ECB")(cons "ì" "\U+1EE1")(cons "þ" "\U+1EF5")
(cons "Æ" "\U+1EB7")(cons "®" "\U+0111")(cons "î" "\U+1EE3")(cons "¦" "\U+01AF")
(cons "¢" "\U+00C2")(cons "§" "\U+0110")(cons "¤" "\U+00D4")(cons "¥" "\U+01A0")
(cons "¡" "\U+0102")(cons "£" "\U+00CA")))
(setq index 1 stdich "")
(repeat (strlen stsua)
(setq chuht (substr stsua index 1)
index (1+ index)
chusua (cond ((assoc chuht tapsua) (cdr (assoc chuht tapsua))) (t chuht))
stdich (strcat stdich chusua)))
stdich)))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end

Lisp của bác viết rất hay. Vote cho bác 1 cái. Tuy nhiên nếu như mình kích chọn Pline rồi chọn 1 điểm xa cái Pline đó thì điểm thêm sẽ không đúng ý (Giống như của Ketxu đó). Vẫn còn thiếu chức năng xóa đỉnh Pline. Hii. Đấy là em nhận xét và so sánh thôi vì cả 2 lisp đều pro mà. Hii.
  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#11 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 23 July 2011 - 10:41 AM

Lisp của bác viết rất hay. Vote cho bác 1 cái. Tuy nhiên nếu như mình kích chọn Pline rồi chọn 1 điểm xa cái Pline đó thì điểm thêm sẽ không đúng ý (Giống như của Ketxu đó). Vẫn còn thiếu chức năng xóa đỉnh Pline. Hii. Đấy là em nhận xét và so sánh thôi vì cả 2 lisp đều pro mà. Hii.

trong đó có lệnh xóa đỉnh pline rồi mà bạn. lệnh edv đó, mình tách nó ra chứ không muốn gộp chung vào 1 lệnh cho đỡ lằng nhằng.
về việc pick 1 điểm xa pline kết quả không như ý là đúng rồi. bởi thực tế sử dụng mình thấy rất ít khi có nhu cầu như vậy nên bỏ lựa chọn phân đoạn để thêm đỉnh, giảm được 1 lần pick cho mỗi đỉnh cần thêm, điểm pick sẽ được gắn vào phân đoạn gần nó nhất.
Nếu cần tổng quát thì các bạn sử dụng lisp của ketxu, còn nếu đại lãn như mình, ngại 1 vài cái pick chuột thì.. lisp của mình chơi được :rolleyes:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#12 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 July 2011 - 11:24 AM

Hi hi, tks bác đã góp ý, cái này gọi là điểm thiếu chứ k gọi là điểm dở, vì e đã code case này đâu. Code update bên trên ạ :rolleyes:
Code của bác giúp e biết thêm phần iniget ^^
Còn chế độ bắt điểm khi add thì chưa hợp lý lắm, và đôi khi add hay erase không đúng ý ^^
Cái vụ TCVN-Unicode k hiển thị đúng trong máy e, lạ thật !
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#13 nmhbg

nmhbg

    Chưa sử dụng CAD

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

Đã gửi 31 August 2011 - 05:49 PM

Đề nghị các bạn cho mình đoạn lisp thêm đỉnh cho polyline khép kín với số lượng xác định trưỡc
  • 0

#14 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 31 August 2011 - 09:07 PM

Đề nghị các bạn cho mình đoạn lisp thêm đỉnh cho polyline khép kín với số lượng xác định trưỡc

Đề nghị đã được xét duyệt. Vậy bạn chờ nhé :blush:
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#15 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 03 April 2013 - 12:21 PM

Lisp của ketxu hoạt động rất tốt, tuy nhiên mỗi lần chèn đỉnh vẫn phải chọn phân đoạn nên rất bất tiện nếu muốn chèn nhiều điểm. Nếu cho phép chèn "multiple" trên một đoạn bất kỳ thì tốt hơn rất nhiều.


  • 0

#16 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 03 April 2013 - 12:25 PM

Oh, tuỳ chọn Undo của ketxu rất nguy hiểm.

Command:  VTX undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: Begin
Command: Thêm hay bớt vextex ? [T / B]t
Chọn phân đoạn muốn add thêm vertex : undo Current settings: Auto = On, Control
= All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: mark
Command:
Pick điểm thêm vertex :
Chọn phân đoạn muốn add thêm vertex : u undo Current settings: Auto = On,
Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: back This will undo everything. OK? <Y>
Chọn phân đoạn muốn add thêm vertex : u undo
Yes or No, please.
This will undo everything. OK? <Y> back
Yes or No, please.

Chọn phân đoạn muốn add thêm vertex :  This will undo everything. OK? <Y> undo
Yes or No, please.
This will undo everything. OK? <Y> end
Yes or No, please.
nil
This will undo everything. OK? <Y>  GROUP GROUP LINE VLIDE GROUP FILLET PLINE
PLINE GROUP
Everything has been undone

Nguy hiểm nhất là Undo everything với tuỳ chọn Yes mặc định, nếu nhấn enter thì coi như bạn ... chưa làm gì từ lúc mở bản vẽ.


  • 1

#17 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 03 April 2013 - 12:47 PM

Cả 2 vấn đề LL nêu đều nhìn thấy trong code, vậy bạn thử tự sửa xem sao ^^


  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#18 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 03 April 2013 - 01:10 PM

Nếu tự sửa thì mình đã làm việc đó và up code mới lên rồi, cần gì phải nêu ra hả bạn? Nếu tất cả đều có thể tự làm thì việc tồn tại 4R liệu có cần thiết?
  • 0

#19 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 03 April 2013 - 01:49 PM

Nếu tự sửa thì mình đã làm việc đó và up code mới lên rồi, cần gì phải nêu ra hả bạn? Nếu tất cả đều có thể tự làm thì việc tồn tại 4R liệu có cần thiết?


Vậy sao bạn k đặt câu hỏi ? Ban thử sửa chưa? Nó vấp ở đâu rồi ?
Nếu cứ nêu ra là mọi vấn đề được giải quyết thì ta dùng fb, blog, sms ... cũng đc vậy, khỏi 4r luôn :))
Vui vậy thôi, chẳng ai nâng quan điểm lên từ ch này cả Ll ạ. Mình trả lời theo tên nick của bạn thôi, nếu bạn cũng k hứng thú vận động trước thì chúng ta cùng ... chờ các bác khác giúp, vì lisp này ket chôm lại, ket đọc cũng mù tịt á ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#20 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 03 April 2013 - 03:53 PM

... ket đọc cũng mù tịt á ^^

Oh, really??


  • 0