Thaistreetz
-
Số lượng nội dung
905 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
29
Bài đăng được đăng bởi Thaistreetz
-
-
Tôi có 1 tập hợp chọn ss1 (hoặc 1 list1 các ename, hoặc 1 list1 các vla-object). Tôi muốn copy chúng từ pt1 đến pt2, và sau khi copy tôi muốn lấy được các đối tượng được tạo thành là tập hợp chọn ss2 (hoặc 1 list2 các ename, hoặc 1 list2 các vla-object), điều kiện là không dùng hàm (command "copy"...). Ai biết xin chỉ giùm hàm hoặc phương pháp thực hiện, thanks!
Không sử dụng (command "copy"...) thì chỉ thực hiện được với các đối tượng đơn giản. Không thể thực hiện tổng quát được trừ trường hợp bạn viết được 1 lệnh có chức năng như lệnh copy. 1 số đối tượng chúng ta không thể make được hoặc quá khó để make như hatch, mline, dimension, wipeout..
-
Ông thầy nào mà lại giao đồ án hay luận văn đề tài này nhỉ? <_<
hồi trước thấy có mấy sinh viên làm nghiên cứu khoa học, đề tài là viết 1 chương trình chạy trắc dọc thoát nước bằng lisp đã thấy buồn cười rồi :lol:
-
Bác liên hệ với bác Nguyễn Hoành để edit lại cadviet antivirut. CAV của bác Hoành nó xử đẹp file acad.lsp của bác nên Cad không tự động load các modul của chương trình lên được.
-
Lúc đầu E chạy TD (hình 01), sau đó E chỉnh sửa số liệu và chạy lại ra hình 02. Nhưng không hiểu sao khoảng cách cờ cao quá nhưng không biết phải chỉnh sao cho giống MC (hình 01) lúc đầu được? Vậy AE nào biết cách chỉnh có thể giúp E được không?
file gửi kèm theo: http://www.mediafire...hb28pq2q4ahojhk
Nó cao thì bạn kéo nó xuống thấp chứ sao. lệnh MOVE hoặc STRETCH :mellow:
-
vấn đề này đơn giản thôi mà.
điều kiện chắc chắn phải là : tỷ lệ giữa các cạch của hình chữ nhật và các cạch của viewport phải bằng nhau.
để đưa hình chữ nhật trùng khít với viewport các bạn dùng lệnh ALIGNSPACE (của express tool). cụ thể thế nào thì các bạn tự mò theo hướng dẫn tại dòng nhắc lệnh của nó cho nhớ nhé
-
2
-
-
Ketxu Thêm cái editbox để đặt tên cho theme hiện thời vào nữa đê. nghịch thế mới sướng :D
-
Get the last command.
Mình đang cần lấy chuỗi tên lệnh cuối cùng đã nhập trong dòng lệnh mà mò mãi chưa ra. Có bác nào có nhu cầu này chưa?
Có 2 cách hiểu lệnh cuối cùng, ví dụ: ta viết 1 code lisp có tên lệnh là (defun C:AA chẳng hạn) rồi gõ lệnh AA để chạy lệnh này
- Lệnh cuối cùng là lệnh trước khi ta chạy lệnh AA. (Mình cần thằng này)
- Lệnh cuối cùng chính là lệnh AA. (thằng này không phải là thằng mình cần, nhưng có cũng tốt, có thể sẽ có ứng dụng hay ho cho nó)
-
dùng lệnh flatten, lệnh tắt là FT
-
1
-
-
hà hà. tạm dừng viết lisp free mà vẫn post đều đều thế hả ketxu? Cái này cũng hay đấy, đỡ ngại mỗi lần fải cài lại cad.
-
Hàm ST:VP-Toggle-DisplayLocked ngon quá! thank sờ kiu :D
Nhưng nên là thế này thì phù hợp với thói quen sử dụng hơn ketxu ạ
(defun C:vtl ( / SelSet ST:VP-Toggle-DisplayLocked) ;VP toggle Locked ;======== Local Function ========= (defun ST:VP-Toggle-DisplayLocked (vpObj / rt) ;vp : vlaObject ;RT : T if Lock VP / nil if Open (cond ((eq (vla-get-DisplayLocked vpObj) :vlax-false)(vla-put-DisplayLocked vpObj :vlax-true)(setq rt T)(vla-put-color vpObj acBlue)) (T (vla-put-DisplayLocked vpObj :vlax-False)(vla-put-color vpObj acByLayer))) ) ;========== Start Here ============== (grtext -1 "Free Lisp from Cadviet @Ketxu") (cond ((< (atof (getvar "ACADVER")) 15.0) (alert " Lisp requires AutoCAD 2000 or higher. ")) ((= (getvar "TILEMODE") 1) (alert " Lisp can only be done in paper space. ")) ((> (getvar "CVPORT") 1) (ST:VP-Toggle-DisplayLocked (vlax-ename->vla-object (acet-currentviewport-ename)))) ((and (not (prompt "\nSelect Viewport for (un)lock... ")) (not (setq SelSet (ssget '((0 . "VIEWPORT")))))) (princ "Nothing or no Viewport selected.")) (T (vl-load-com) (vlax-for vpObj (setq SelSet (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))) (ST:VP-Toggle-DisplayLocked vpObj) ))) (princ) ) )
-
1
-
-
thực ra nếu nhu cầu cần fải lock/unlock là thường xuyên thì lệnh này sẽ cần thiết đấy. đọc yêu cầu mới nhận ra mình cũng cần lệnh này, tuy nhiên cần cải tiến cách thức 1 chút để dễ dàng làm việc với nó hơn.
Cụ thể ta sẽ viết lệnh này như 1 cái công tắc điện. nếu viewport đang khóa thì khi gõ lệnh nó sẽ được mở ra. và ngược lại, nếu viewport đang mở thì khi gõ lệnh nó sẽ được khóa lại.
Ý tưởng là thế, mình đang bận chưa viết được, các bác thử nghiên cứu xem <_<
-
Tue_NV thử tạo 1 Dynamic Block là 1 line (có strecth parameters ở 2 đầu) sau đó dùng command insert vào rồi làm sao thay đổi được chiều dài (parameter) của Block đó?
Nếu dc thì Tue_NV chỉ giúp nha.
Thanks!
Có 1 bất tiện nữa của Command so với entmake mà ít khi chúng ta để ý đến, nhưng hậu quả thì tương đối khủng khiếp. Nếu chúng ta sử dụng command quá nhiều lần trong 1 lênh lisp, khi kết quả của lệnh đó không làm bạn hài lòng thì bạn có thể dùng lệnh undo. => Chúc mừng, bạn có thời gian rảnh rỗi thưởng thức 1 ấm trà trong khi chờ undo xong. Nhưng nếu bạn đen đủi thì có thể cad của bạn sẽ treo cứng luôn đấy.
Theo như kiến thức nông cạn của mình thì Chúng ta chỉ thực hiện đuợc mỗi việc insert cái block đó bằng command. còn thay đổi nó thì vô fuơng. mà nếu chỉ mỗi việc insert nó vào bản vẽ thôi thì entmake cũng chẳng có gì là fức tạp so với command cả. Mình đã thấy có nguời viết đuợc hàm thay đổi các thông số động của Dynamic Block, bằng VLA thì phải.
Bác Tue_NV chắc chưa bg viết cái gì đó mà phải tạo ra con số hàng nghìn hay hàng chục nghìn đối tượng nên bác chấp nhận được command và trung thành với nó. hoặc có thể bác là người dễ tính, sống đơn giản (hơi chủ quan tý) <_<
-
Chưa đủ, vì đụng đến thằng nào thì mình mới viết cho thằng đấy. các bác bổ sung thêm các đối tượng khác cho em nó được tròn trịa.
Tiện đây mình đố bác nào viết được cái hàm make MLine. mình trả 20 (+) luôn, hề hề :lol:
Quote==================================================
Entmake Object defun by Thaistreetz - Cadviet.com
==================================================
====== List support object ========
- Text
- Line
- Point
- LWPolyline
- Spline
- MakeCircle
- MakeRectang :P
- Layer
- Wipeout
- Group
- MlineStyle (view more DelMLineStyle defun)
- MakeMline _false :(
- MakeRegion (one Boundary and Two Boundary)
- Insert (support ATT Block)
- Xline
- Ray
- Light
...
===================================
;|================================================= Entmake object defun by Thaistreetz - Cadviet.com ================================================== ====== List support object ======== - Text - Line - Point - LWPolyline - Spline - MakeCircle - MakeRectang - Layer - Wipeout - Group - MlineStyle (view more DelMLineStyle defun) - MakeMline _false :( - MakeRegion (one Boundary and Two Boundary) - Insert (support ATT Block) - Xline - Ray - Light ... ===================================|; (defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst); Ang: Radial (setq Lst (list '(0 . "TEXT") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) (cons 10 point) (cons 40 Height) (cons 1 string) (if Ang (cons 50 Ang)) (cons 7 (if Style Style (getvar "Textstyle"))) (cons -3 (if xdata (list xdata) nil))) justify (strcase justify)) (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point))))) ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point))))) ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point))))) ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3))))) ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3))))) ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3))))) ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2))))) ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2))))) ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2))))) ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1))))) ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1))))) ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))) (entmakex Lst));end ;================================= (defun MakeLine (PT1 PT2 Linetype LTScale Layer Color xdata) (entmakex (list '(0 . "LINE") (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)) (cons 10 PT1) (cons 11 PT2) (cons -3 (if xdata (list xdata) nil)))));end ;================================= (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 ;================================= (defun MakeCircle (point R Linetype LTScale Layer Color xdata) (entmakex (list '(0 . "CIRCLE") (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)) (cons 10 point) (cons 40 R) (cons -3 (if xdata (list xdata) nil)))));end ;================================= (defun MakeRectang (PT1 PT2 Linetype LTScale Layer Color xdata) (entmakex (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 4) (cons 70 1) (cons 10 PT1) (cons 10 (list (car PT1) (cadr PT2))) (cons 10 PT2) (cons 10 (list (car PT2) (cadr PT1))) (cons -3 (if xdata (list xdata) nil)))));end ;================================ (defun MakeLayer (name color linetype lineWeight plot) (entmakex (list '(0 . "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 name) (cons 70 0) (cons 62 (if color color 7)) (cons 6 (if linetype linetype "Continuous")) (cons 290 (if plot 1 0)) (cons 370 (if lineWeight (fix (* 100 lineWeight)) -3)))));end ;================================= (defun MakeSPline (listpoint Linetype LTScale Layer Color xdata / Lst) (setq lst (list '(0 . "SPLINE")'(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 . "AcDbSpline") (cons 71 3) (cons 74 (length listpoint)))) (foreach PP listpoint (setq Lst (append Lst (list (cons 11 PP))))) (if xdata (setq Lst (append lst (list (cons -3 (list xdata)))))) (entmakex Lst));end ;================================ (defun MakeWipeout (listpoint Layer Color xdata / dxf10 max_dist cen dxf14) (if (not (member "acwipeout.arx" (arx))) (arxload "acwipeout.arx")) (setq dxf10 (list(apply'min(mapcar'car listpoint))(apply'min(mapcar'cadr listpoint))(if(caddar listpoint)(caddar listpoint)0)) max_dist(float(apply'max(mapcar'-(apply'mapcar(cons'max listpoint))dxf10))) cen (mapcar'+ dxf10(list(/ max_dist 2)(/ max_dist 2) 0.0)) dxf14 (mapcar'(lambda(p)(mapcar'/(mapcar'- p cen)(list max_dist(- max_dist)1.0)))listpoint) dxf14 (reverse(cons(car dxf14)(reverse dxf14)))) (entmakex (append (list '(0 . "WIPEOUT")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbWipeout")'(90 . 0) (cons 10 (trans dxf10 (list 0 0 1) 0)) (cons 11 (trans (list max_dist 0.0 0.0) (list 0 0 1) 0)) (cons 12 (trans (list 0.0 max_dist 0.0) (list 0 0 1) 0)) '(13 1.0 1.0 0.0)'(70 . 7)'(280 . 1)'(71 . 2) (cons 91 (length dxf14))) (mapcar'(lambda(p)(cons 14 p))dxf14) (list (cons -3 (if xdata (list xdata) nil))))));end ;================================ (defun MakeGroup (lstEname Description / dict ind) (setq dict (dictsearch (namedobjdict) "ACAD_GROUP") ind "GRP1") (while (member (cons 3 ind) dict) (setq ind (strcat "GRP" (itoa (1+ (atoi (substr ind 4))))))) (dictadd (cdr (assoc -1 dict)) ind (entmakex (append (list '(0 . "GROUP")'(100 . "AcDbGroup")(cons 300 Description)'(70 . 0)'(71 . 1))(mapcar'(lambda(x)(cons 340 x))lstEname)))) );end ;================================ (defun MakeMlineStyle (Name Description ColorFill LineLst / Dic Lst Obj) ; (LineLst: offset color linetype) (setq Lst (list (cons 0 "MLINESTYLE") (cons 100 "AcDbMlineStyle") (cons 2 Name) (if (and ColorFill (< 0 ColorFill 256)) (cons 70 1) (cons 70 0)) (cons 3 Description) (if (and ColorFill (< 0 ColorFill 256)) (cons 62 ColorFill) (cons 62 256)) (cons 51 (* pi 0.5)) (cons 52 (* pi 0.5)) (cons 71 (length LineLst)))) (foreach LL LineLst (setq Lst (append Lst (list (cons 49 (car LL)) (cons 62 (if (and (cadr LL) (< 0 (cadr LL) 256)) (cadr LL) 256)) (cons 6 (if (caddr LL) (caddr LL) "BYLAYER")))))) (if (and (setq Dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE")) (not (dictsearch (setq Dic (cdr (assoc -1 Dic))) (cdr (assoc 2 LST)))) (setq Obj (entmakex Lst))) (dictadd Dic (cdr (assoc 2 Lst)) Obj)) );end (defun DelMLineStyle ( Name / Dic ) ; Remove Mline Style (if (setq Dic (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))(dictremove (cdr (assoc -1 Dic)) Name)) );end ;================================ ;|(defun MakeMline (listpoint closed MLstyle Scale LTScale Justify Layer / LST) ;Justify: T M B (setq Lst (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) '(100 . "AcDbMline") (cons 2 MLstyle) (cons 40 (if Scale Scale 1)) (cons 70 (cond ((= Justify "T") 0) ((= Justify "M") 1) ((= Justify "B") 2))) (cons 71 (if closed 3 1)) (cons 72 (length listpoint)) (cons 48 (if LTScale LTScale 1)) )))|; (defun MakeRegion (en) (if (vlax-curve-isClosed en) (vlax-invoke(vlax-get-property(vla-get-ActiveDocument(vlax-get-acad-object))(if(= 1(getvar'CVPORT))'Paperspace'Modelspace))'AddRegion(list(vlax-ename->vla-object en))))nil) (defun MakeRegion2 (en1 en2 / space) (setq space (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))) (if (and (vlax-curve-isClosed en1) (vlax-curve-isClosed en1)) (vla-Boolean (vlax-invoke 'AddRegion (list (vlax-ename->vla-object en1))) acSubtraction (vlax-invoke 'AddRegion (list (vlax-ename->vla-object en2)))) nil) ) ;;;=============== Make insert block (defun MakeInsert (Blkname inspoint scale ang list_att layer color xdata / lst obj i) (setq lst '() i -1 en (cdr (last (tblsearch "block" Blkname))) obj (entget en)) (if (= (cdr(assoc 0 obj)) "ATTDEF") (setq lst (list (list (cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj)) (cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj))))) (while (setq en (entnext en)) (if (= (cdr(assoc 0 (setq obj(entget en)))) "ATTDEF") (setq lst (cons (list (cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj)) (cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj))lst)))) (entmakex(list '(0 . "INSERT")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbBlockReference") (if list_att '(66 . 1) '(66 . 0)) (cons 2 Blkname) (cons 10 (trans inspoint 1 0)) (cons 41 scale)(cons 42 scale)(cons 43 scale) (cons 50 Ang) (cons -3 (if xdata (list xdata) nil)))) (if lst (foreach LL (reverse lst) (entmake(list '(0 . "ATTRIB")'(100 . "AcDbEntity")(cons 8 (cadddr LL))(cons 60 (nth 4 LL)) (if (nth 5 LL) (cons 62 (nth 5 LL)) '(62 . 256))'(100 . "AcDbText") (cons 10(mapcar'+(trans inspoint 1 0)(mapcar'(lambda(x)(* scale x))(polar'(0 0 0)(+(angle'(0 0 0)(car LL))ang)(distance'(0 0 0)(car LL)))))) (cons 40 (* scale (nth 6 LL))) (cons 1 (nth (setq i (1+ i))list_att)) (cons 50 (+ ang (caddr LL))) '(41 . 1.0)(nth 7 LL)(nth 8 LL)(nth 9 LL) (if (= 0(cdr (nth 8 LL))(cdr(nth 9 LL)))(cons 11(list 0 0 0)) (cons 11(mapcar'+(trans inspoint 1 0)(mapcar'(lambda(x)(* scale x))(polar'(0 0 0)(+(angle'(0 0 0)(cadr LL))ang)(distance'(0 0 0)(cadr LL))))))) '(100 . "AcDbAttribute")'(280 . 0)(last LL)'(70 . 0)'(280 . 1))))) (dxf 330 (entmakex (list '(0 . "SEQEND") (cons 8 (if Layer Layer (getvar "Clayer"))))))) ;;;================ make point (defun MakePoint (point layer color) (entmakex (list '(0 . "POINT")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbPoint")(cons 10 point)))) ;;;================ make ray (defun MakeRay (Point vector layer color) (entmakex (list '(0 . "RAY")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbRay") (cons 10 Point) (cons 11 vector)))) (defun MakeXline (Point vector layer color) (entmakex (list '(0 . "XLINE")'(100 . "AcDbEntity") (cons 8 (if Layer Layer (getvar "Clayer"))) (cons 62 (if Color Color 256)) '(100 . "AcDbXline") (cons 10 Point) (cons 11 vector)))) ;;;================ make point light (defun MakeLight (Point) (if PointLightName (setq PointLightName (strcat "PtLight" (itoa (1+ (atoi (substr PointLightName 8)))))) (setq PointLightName "PtLight1")) (entmakex (list '(0 . "LIGHT")'(100 . "AcDbEntity")'(8 . "*ADSK_SYSTEM_LIGHTS")'(100 . "AcDbLight")'(90 . 1)(cons 1 PointLightName)(cons 10 Point))) );end
Edit: Chú ý:
- với code trên, bác nào không có nhu cầu dùng xdata thì nên sửa lại bỏ nó đi cho gọn.
- Các tham số về layer, Color, Linetype, LTScale, Angle... Nếu đặt là nil thì hàm sẽ lấy các giá trị hiện hành của bản vẽ.
-
8
-
-
:D thế bạn ấy mới bẩu là "tham khảo có chỉnh sửa" còn gì, mặc dù đoạn chỉnh sửa không biết là bao nhiêu % ^^ (diễn đàn ít emotion cười quá, hok lăn lộn hoặc đập tay xuống đất được ^^). Thôi thì cũng là điều tất cả mọi người nên suy nghĩ. Ở các diễn đàn Tây (trừ Tàu) như thế này dễ bị tẩy chay lắm ^^.
E vẫn còn nhớ câu chuyện dùng hàm Listbox show của LeeMac, mới xóa đi cái ngày tháng viết hàm + ghi chú các đối số (vẫn để nguyên tên tác giả) mà còn bị cháo hành giềng tỏi, xin lỗi đến khổ, mà TA thì dốt chứ có phải giỏi như người ta đâu, nói mãi không diễn tả được câu "Em không cố ý" :lol:
Gà vãi 
-
1
-
-
Lisp này chinh xác là của mình viết mà. sao lại có ";; Viet ham moi by Son Pro"
-
1
-
-
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:
-
nhận xét qua cho bạn:
- ứng dụng của bạn lỗi tùm lum te le luôn. lỗi do thiếu hàm con, lỗi do sử dụng command để vẽ đói tuợng nhưng set biến hệ thống không tốt dẫn đến đối tuợng vẽ ra bay lung tung hết cả; có thể lỗi nguyên nhân còn do cấu trúc hàm command thay đổi giữa các phiên bản cad nên cad của mình (2010) không vẽ ra đuợc cái gì cả.
- ứng dụng của bạn rất vụn vặt. là kết quả do bạn tự viết, đồng thời một số là bạn gom nhặt trên diễn đàn và một số tác giả khác nên có lẽ chỉ chạy ổn định đuợc với máy của bạn. sang máy của nguời khác dễ bị xung đột với hàm và biến trong các ứng dụng của họ. viết 1 ứng dụng kiêm nhiệm nhiều thứ, nhiều lệnh thế mà lại viết và tổ chức rời rạc như vậy không lỗi mới lại. bạn nên tổ chức thành 1 project để dễ kiểm soát.
- Chương trình thống kê thép của bạn có giao diện khá thân thiện với người dùng, mình thấy rất thích dù kết quả thì cũng chưa biết thế nào vì không chạy được :D
-
Tất nhiên là không được roài, bởi các lệnh của ứng dụng gốc được đóng gói vào 1 file FAS duy nhất, trong đó không chỉ có lệnh Lisp mà còn có cả các hàm con của nó.
cái mà mình muốn là 1 giải pháp loại bỏ triệt để mọi ứng dụng cá nhân ra khỏi bản vẽ 1 chỉ bằng 1 lệnh được nhúng trong chính ứng dụng đó cho nhanh gọn và tránh mọi xung đột có thể sảy ra. nó giống như là khi ta load 1 ứng dụng arx rùi sau khi không dùng nữa có thể unload nó ra khỏi bản vẽ mà không để lại dấu vết gì í.
Tiện thể cho mình hỏi, bạn có biết cách sử dụng hàm vl-unload-vlx không? mình đọc help mà làm hoài không fát nào trả về T được :(
-
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
-
-
không đơn giản chỉ là tắt đi mở lại đâu ketxu. sẽ fải remove lisp ra khỏi startup suite truớc khi tắt bản vẽ. rồi lần sau muốn dùng thì lại fải mất công add lại rất là loằng ngoằng. làm 1, 2 lần không sao. nhưng thêm vài lần nữa là đã cảm thấy chán rồi.
ở cty mình có 1 bộ ứng dụng được áp dụng cho toàn cty, nhưng do trong quá trình làm việc mỗi người lại hình thành những thói quen nhất định theo tích chất công việc nên lại tự viết riêng ứng dụng cho minh, tên lệnh đè lên ứng dụng gốc là chuyện thường xuyên.
-
Đúng rồi. Hay :lol: Thế mà ko nghĩ ra. Cảm ơn các bác :lol:
Chả thấy hay tí nào. Giả sử trước khi load lisp ta có lệnh ABC thực hiện chức năng 1. lisp được load vào cũng có 1 lệnh là ABC sẽ thực hiện chức năng 2. mình muốn sau khi unload nó trả lại chức năng cũ của lệnh đó trước khi load. Ý của chủ topic chắc cũng giống ý này của mình.
Mục đích của việc này là để tạo ra sự linh động, người khác ngồi vào máy của mình nếu không quen với hệ thống tên lệnh của mình thì có thể unload nó đi 1 cách dễ dàng hơn.
Ẹc. ketxu xóa dùm mình 1 bài nhé. thank
-
Câu hỏi này hơi buồn cười nhưng mình đang có nhu cầu: Có cách nào để unload 1 lisp đã đuợc load vào bản vẽ không nhể. (không chơi cách tắt bản vẽ đi rồi mở lại nha)
Edit: Vừa mò thấy topic này, không ngờ cũng có người có nhu cầu giống mình. mọi thảo luận xin chuyển qua topic này nhé
-
bạn làm vậy là đúng rồi. mình đã test lại. chạy bình thuờng
-
@NguyenNgocSon: để xuất text kết quả có màu theo ý của bạn thì bạn tìm dòng này: (DXF 40 SSn) 0 "R"(DXF 7 SSn) (DXF 8 SSn) nil nil)
đổi giá trị nil mình đánh dấu đỏ thành mã màu bạn muốn. Ví dụ bạn muốn là màu 3 thì: (DXF 40 SSn) 0 "R"(DXF 7 SSn) (DXF 8 SSn) 3 nil)
Về code mình viết, mình không muốn đưa thêm lựa chọn tính chính xác đến bao nhiêu số sau dấu phẩy vì thực tế các phép tính chúng ta sử dụng trên bản vẽ chỉ tính đến 2 con số. mình đã từng rất ức chế khi sử dụng lisp của đồng nghiệp viết trong đó mọi phép tính toán đều bị hỏi thêm 1 câu "lấy tròn bao nhiêu số sau dấu phẩy" thừa thãi như vậy. đưa vào chỉ thấy rối và khó sử dụng :)
-
1
-
Hỏi về Lisp (thuật toán, ý tưởng, coding,...)
trong AutoLisp
Đã đăng · Trả lời báo cáo
Acet có mấy hàm thuộc loại kịch độc mà mình thích sử dụng nhưng không thể viết lại được (hoặc có viết lại được thì cũng không thể ngon bằng nó)
VD: acet-sys-shift-down, acet-sys-lmouse-down, ss-drag..
thêm nữa, mình test thử tốc độ thì thấy các hàm acet cho tốc độ cực nhanh, VL và VLA có 1 số hàm chức năng tương tự acet nhưng tốc độ cũng không bằng. thế nên là mình vẫn cứ thích dựa hơi nó. he he