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

conghoan1003

Thành viên
  • Số lượng nội dung

    99
  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi conghoan1003


  1. Chào mọi người!

    hôm trước mình có tìm được cái lisp mplot dùng thấy rất hay nhưng giờ gặp vấn đề mong anh em giúp đỡ.

    Khi mình in bên model thì ok nhưng khi in bên layout thì lisp báo lỗi:

    "Command: MPL

    Select objects: Specify opposite corner: 1 found

    Select objects:

    1=0.20

    Yes or No, please.

    Yes or No, please.

    ; error: An error has occurred inside the *error* functionFunction cancelled

    Save changes to page setup [Yes/No]? *Cancel*"

    Ai biết chỉ dùm mình với. Cảm ơn nhiều!

    file cad: http://www.cadviet.com/upfiles/2/tnct_7.dwg

    (in với block tên là : in)

    Cái MPL này của Bác Hoành, không biết mấy hom nay Bác đi đâu nhỉ!

    lisp mpl: http://www.cadviet.com/upfiles/2/mplot_2.rar

    ai biết giúp mình với!


  2. Chào mọi người!

    hôm trước mình có tìm được cái lisp mplot dùng thấy rất hay nhưng giờ gặp vấn đề mong anh em giúp đỡ.

    Khi mình in bên model thì ok nhưng khi in bên layout thì lisp báo lỗi:

    "Command: MPL

    Select objects: Specify opposite corner: 1 found

    Select objects:

    1=0.20

    Yes or No, please.

    Yes or No, please.

    ; error: An error has occurred inside the *error* functionFunction cancelled

    Save changes to page setup [Yes/No]? *Cancel*"

    Ai biết chỉ dùm mình với. Cảm ơn nhiều!

    file cad: http://www.cadviet.com/upfiles/2/tnct_7.dwg

    (in với block tên là : in)


  3. Nhờ các bác viết giúp cái lisp như thế này:

    bản vẽ của mình có một số đường có cao độ z, khi thao tác gặp rất nhiều bất tiện, mình muốn đưa các đối tượng đó cao độ z=0. Nhưng sau khi dung lisp supeiron trên diễn đàn thì các đối tượng nhảy lung tung hết. Nhờ các bác viết dùm lisp đưa các đối tượng về 0 nhưng không làm thay đổi vị trí của nó trên bản vẽ.

    file chạy thử: http://www.cadviet.com/upfiles/2/bd.dwg


  4. Chiều nay em bận quá, giờ mới post lên cho bác được.

    Lisp của bác đây ạ:

    - Pick điểm tim trắc ngang -> Pick chọn text cao độ tương ứng của tim

    - Pick các điểm cần lấy cao độ thiết kế -> Pick chọn text để ghi cao độ điểm đó. -> tiếp tục pick các điểm khác... Enter để kết thúc.

    (defun DXF (code elist)  (cdr (assoc code elist)))
    (prompt"\n[cmd : CTN] - GHI CAO DO TRAC NGANG\n")
    (defun c:ctn ()
    (command "Undo" "BEGIN")
    (setq CMLAST (getvar "cmdecho"))
    (setq OSLAST (getvar "OSMODE"))
    (setq DZ (getvar "DIMZIN"))
    (setq OT (getvar "ORTHOMODE"))
    (setvar "ORTHOMODE" 0)
    (setvar "cmdecho" 0)
    (command "osmode" 1)
    (setq pt0 (osnap (getpoint "Diem tim TN tu nhien") "end")) (print)
    (setq y0 (cadr pt0))
    (setq ed (entget (car (entsel "\nChon text cao do tim: "))))
    (setq H0 (read (DXF 1 ed)))    
    (command "osmode" 4335)
    (setq pt (getpoint "\nDiem tra cao do: "))
    (While (/= pt nil)
    (setq y (- (cadr pt) y0 (- H0)) out 0)
    (while (= out 0)
    (setq res (entsel "\n Chon text ghi cao do"))
    (if res
    (progn
    (setvar "dimzin" 0)
    (entmod (subst (cons 1 (rtos y 2 2)) (assoc 1 (entget (car res))) (entget (car res))))
    (setq out 1)
    );progn
    );if
    );while
    (setvar "DIMZIN" DZ)
    (command "osmode" 4335)
    (setq pt (getpoint "\nDiem chen: "))
    );while 
    (setvar "OSMODE" OSLAST)
    (setvar "ORTHOMODE" OT)
    (setvar "cmdecho" CMLAST)
    (prompt"\n[GHI CAO DO TREN TRAC NGANG] by Thaistreetz - huuthais@yahoo.com\n")
    (command "Undo" "End")
    (princ)
    );end
    ;---------------------------------------------------------------
    

    Cảm ơn Thaistreets! Đúng cái mình cần rồi, Lisp tốt lắm!


  5. Chào bác Conghoan

    Bản vẽ bác up lên em xài cad2005 ko mở được, nhưng em đoán thế này ko biết có đúng không:

    Bác đã thiết kế xong và đang trong quá trình hoàn thiện bản vẽ trên cad (cơ sở dữ liệu của nova lúc này đã không còn) và bác fát hiện ra là bác quên chưa điền thiết kế trắc ngang. bg bác cần 1 lisp để điền lại cao độ thiết kế cho bảng trắc ngang fía dưới fải không?

    Nếu vấn đề đúng như trên thì em có thể giúp bác được. em cũng từng dính trường hợp này :cheers:

    Đúng rồi Thaistreets!

    Mình thiết kết trắc ngang nhưng khi xuất qua cad rồi mà có một số thay đổi nên cao độ thiết kế tại một số điểm trên mặt cắt bị sai. Nhưng cao độ thiết kế tại tim đường (của mỗi mặt cắt) thì vẫn đúng. Nên mình muốn dựa vào cao độ thiết kế tại tim đường của mỗi mặt cắt để tình lại cao độ tại các điểm bị sai.

    Cảm ơn Thaistreets đã giúp đỡ!


  6. Hy vọng là đúng ý bạn.
    (defun C:caodo(/ osm dc cd k dg)
     (defun *error* (msg)
       (if ov (mapcar 'setvar vl ov))
       (if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
         (princ (strcat "\n** Error: " msg " **")))
       (princ))
    
     (vl-load-com)
     (command "undo" "be")
     (setq vl '("CMDECHO" "OSMODE" "orthomode")
           ov (mapcar 'getvar vl))
     (mapcar 'setvar vl '(0 33 0))
     (setq dc (getvar "userr1") cd (getvar "userr3" ))
     (if (= dc 0) (setq k "y") (setq k (getstring "\nThay doi diem goc & cao do Thiet ke ?(N)")))
     (if (or (= k "y")(= k "Y") )
       (progn
         (setq dg (getpoint "\nDiem goc Thiet ke :")
        dc (cadr dg)
        cd (getreal (strcat "\nCao do Thiet ke tuong ung" " <" (rtos (getvar "userr3")) "> : ")) )
         (if cd (setvar "userr3" cd) (setq cd (getvar "userr3")) )
         (setvar "userr1" dc)))
    
     (while (setq dg (getpoint "\nDiem can tim cao do :"))
       (setq ST (entsel "\nChon text can gan cao do: "))
       (and
         (setq obj (vlax-ename->vla-object (car st)) )
         (if (= (vlax-get obj 'ObjectName) "AcDbText")
          (vlax-put obj 'TextString (rtos (+ (- (cadr dg) dc) cd) 2 2))
          )
         )
       )
     (mapcar 'setvar vl ov)
     (command "undo" "e")
     (princ)
    )

    Chào Gia bach!

    cái này cũng gần đúng ý của mình rồi, Gia bach sửa lại giúp mình tí nha.

    Sau khi pick điểm thay đồi điểm gốc và cao độ thiết kế mình pick vào một cái text, và text này về "0" và cao độ tại tim đường là "0". Nhưng mình muốn text này không thay đổi và cao độ thiết kế tại tim đường có giá trị bằng giá trị trong text. Rồi sau đó mình đi tìm các cao độ của các điểm khác và gán vào các text tương ứng bên dưới. Có nghĩa là cao độ tim đường đã biết và từ cao độ này mình đi tìm các cao độ của các điểm khác.

    Cảm ơn & chúc sức khoẻ!


  7. Đúng là khó hiểu thật. fải chăng bạn đang cần lisp này

    @ master_worse: Bạn bấm nút Reply góc dưới bên fải của mỗi bài viết thử đi. Mình đoán hình như bạn chỉ có sử dụng Fast Reply thì fải.

    cái này không đúng ý của mình mong Thaistreetz sửa lại giúp mình tí:

    Ban đầu mình cũng nhập vào giống cái TN của Thaistreetz. Nhưng khi xuất cao độ thiết kế của một điểm nào đó trong trắc ngang thì mình chọn 1 text và sửa text đó lại có giá trị bằng cao độ thiết kế của điểm vừa mới pick. Mình chỉ cần cao độ thiết kế (trong trắc ngang thôi)

    Công việc của mình là như thế này: Mình có một mặt cắt ngang, có cao độ thiết kế tại tâm mặt cắt, giờ mình muốn tìm cao độ thiết kế trên các điểm ở trên mặt cắt và cho vào text bên dưới.

    file cad: http://www.cadviet.com/upfiles/2/tnct_6.dwg

    Thank!


  8. Conghoan này, muốn người khác viết dùm lisp thì phải nêu thật rõ vấn đề, phải có hình ảnh hoặc bản vẽ minh họa đi kèm, Conghoan đã post nhiều mà vẫn để cho người giúp phải hỏi lại nhiều lần!

    Thực ra lisp này dùng để tìm toạ độ y của các điểm khi đã có một điểm cho trước có toạ độ y. Sau khi lấy được giá trị toạ độ y của điểm vừa pick thì mình chọn luôn một text có sẵn để chèn toạ độ y vào. Nó chỉ có thế thôi nhưng vì khả năng sư phạm quá kém nên làm khó mọi người rồi!

    Thank!

    file cad: http://www.cadviet.com/upfiles/2/tam.dwg


  9. Bác nào viết dùm mình cái lisp làm công việc sau:

    Mình có cao độ điểm A, mình muốn tìm cao độ điểm B, C và ghi vào một text có trước.

    Trình tự thực hiện như sau:

    lisp thư nhất tìm cao độ y

    Đánh lênh

    Lisp hỏi điểm gốc (điểm này đã biết cao độ y). sau đó nhập cao độ (y) điểm này.

    Lisp hỏi điểm cần tìm toạ độ y, (kích điểm)

    Sau đó pick text cần chèn cao độ của điểm vừa pick.

    Một cái tương tự nhưng mình muốn tìm toạ độ x. Thank!


  10. Xin bác Nguyen Hoanh và các cao thủ giúp em viết cái LISP thực hiện công việc sau:

    http://www.cadviet.com/upfiles/2/cn.dwg

    Chào trieubb!

    Mình có xem file cad của bạn, đó là mặt cắt ngang, có phải là bạn làm bên cầu đường không? Bạn dùng chương trình gì chạy trắc nagng mà nó chẳng có thẳng hàng gì hết vậy? Mình cũng dùng nhiều chương trình mà chẳng có cái nào lại xuất ra kiểu như bạn cả. Mà hơn nữa bản vẽ của bạn có tới 1000 mặt cắt, không biết bạn có phóng đại lên không nữa. Mình làm đường mấy chục KM thì cũng phải chia hồ sơ ra nhiều đoạn nên mỗi File cũng không đến nỗi nhiều như thế. Bạn có thể up file của bạn lên để bác để mọi người tham khảo nhé. Hơn nữa lisp dùng để làm đi làm lại nhiều lần cho khỏi tốn nhiều thời gian, nếu công việc của bạn có nhiều bản vẽ như thế thì yêu cầu chứ có một file duy nhất thì bạn nên MOVE còn nhanh hơn thời gian viết lisp nhiều đó.

    Mình chỉ góp ý không có ý gì khác mong ban tiếp thu nhé. Chúc bạn thành công!


  11. Hề hề, chào bác Conghoan1003,

    Bác theo đuổi cái thằng líp này cũng kha khá thời gian rồi nhỉ. Với sự giúp sức của các bác Thiep, Tue_NV, hy vọng bác sẽ có thể tự giải quyết được cái yêu cầu bác đặt ra. Thực tế trong công việc của bác dùng lisp khá nhiều, bác hãy mạnh dạn làm thử vài cái là sẽ quen dần thôi. Lisp cũng không quá khó khăn đâu đối với những người đã có nền kiến thức tốt như bác. Khi bác co thể tự làm được những thằng lisp nho nhỏ này, bác sẽ thấy yêu đời hơn khá nhiều và cũng sẽ đỡ bị phụ huộc hơn trong công việc bác ạ.

    Theo yêu cầu của bác thì cái phần đánh số thứ tự điểm theo trật tự bác Tue_NV đã bày rồi, còn phần xuất ra file đã có cái lisp của bác Thiep, bây giờ bác chỉ phải ghép chúng lại với nhau và thay đổi chút xíu trong cái nội dung xuất ra cho phù hợp với yêu cầu của bác thôi mà. Hãy thử xem bác nhé. Rất mong bác thành công.

    Nếu trong quá trình bác chơi thử, có chỗ nào trục trặc thì bác cứ tống nó lên diễn đàn, mọi ngưòi sẽ gỡ giúp bác ngay bác ạ.

    Chào bác, mong bác chơi thiệt hay mọi nhẽ.

    Cảm ơn mọi người đã nhắc nhở!

    Mình cũng đang cố gắng để có thể làm ra một cái gì đó nhưng mà quả thật mới bắt đầu nên gặp nhiều khó khăn quá. Mong mọi người thông cảm! Hy vọng thời gian không xa mình sẽ viết được món này! Chúc anh e diễn đàn sức khoẻ!


  12. Chào CH1003, Lisp chỉnh sửa này sẽ cho phép người dùng tự tạo một file mới để ghi dữ liệu, nếu chọn file có sẵn nó sẽ ghi dữ liệu đè lên file cũ. Nên nhớ rằng lisp yêu cầu mở thư mục để tạo file trước khi yêu cầu người dùng pick point:

    (defun SAVE_MODE ()
     (command "UCS" "W" "")
     (setq	OLD_OSMODE  (getvar "OSMODE"))
     (setvar "cmdecho" 0)
     (setvar "blipmode" 1)
    
    )
    (defun RESTORE ()
     (setvar "osmode" OLD_OSMODE)
     (setvar "cmdecho" 1)
     (setvar "blipmode" 0)
    )
    (defun c:gtd (/ ST fn f x1 y1)
     (setq fn (getfiled "Tao file ghi toa do: " "D:/" "tdo" 1))
     (setq f (open fn "w"))
     (setq ST 1)
     (SAVE_MODE)
     (setvar "osmode" 0)
     (while (setq pt (getpoint "Pick point: "))
       (setq x1 (rtos (car pt) 2 4)
      y1 (rtos (cadr pt) 2 4)
       )
       (write-line (strcat (itoa ST) "\t" x1 "\t" y1) f)
       (setq ST (1+ ST))
       (terpri)
     )
     (close f)
     (RESTORE)
     (redraw)
     (print)
    )

    Lisp tạm thời mở hộp thoại "tạo file ghi toa do" tại thư mục gốc là D:, còn người dùng muốn ghi vào đâu thì tùy, còn muốn thường xuyên ghi vào 1 thư mục nào đó, thì sửa lại dòng này: "D:/"

    Ví dụ, CH1003 muốn ghi vào thư mục đã có sẵn: "E:/Conghoan1003/data/" chẳng hạn. Còn trên máy người dùng chưa có thư mục như ví dụ trên, thì lisp sẽ mở thư mục "My documents" :s_big:

    Cảm ơn Thiêp nha! Lisp chạy tốt lắm.

    Thiep có thể làm thêm mình một cái nữa nhé, Mình muốn kết hợp lisp đánh số thứ tự của các point và sau đó xuất các toạ độ của các point này ra một file .tdo. Fiile .tdo gồm có stt (là số vừa đánh) và toạ độ của point. Toạ độ thì có 2 sự chọn lựa 2D (x,y) hay 3D(x,y,z) tuỳ chọn.

    Lisp đánh số thứ tự point (sưu tầm từ cadviet) nè: http://www.cadviet.com/upfiles/2/stt_point_sttp.lsp

    Cái lisp đánh số thứ tự này đánh từ trái sang phải, Thiep có thể chỉnh lại để nó sắp xếp từ trên xuống cho mình với, mình cần đánh số thứ tự từ trên xuống.

    Cảm ơn nhiều! Chúc Thiep sức khoẻ!


  13. Chào CongHoan, Bởi vì Hoan nói "có lúc tìm hoài chẳng thấy luôn" Vì vậy Thiep muốn Hoan tạo ra 1 file *.tdo rỗng ở thư mục gốc D:\ . Như vậy, Hoan sẽ biết trước file dữ liệu nằm ở đâu. Chắc có lẽ bạn muốn chỉ đưa tên file ghi tọa độ thôi như lisp gốc CongHoan sưu tầm. Nếu vậy, Hoan sửa lại 2 dòng mã như sau:

    (setq fn (getfiled "Chon file ghi toa do: " "D:/" "tdo" 8))

    (setq f (open fn "a"))

    thành:

    (setq file (getstring T "Ten file toa do : "))

    (setq tenf (strcat file ".tdo"))

    (setq f (open tenf "a"))

    File dữ liệu *.tdo sẽ được tự động ghi vào thư mục "My Documents"

    Chào Thiep!

    Có lẽ Thiep hiểu sai ý của mình rồi. Sau khi mình chạy lisp nó cũng xuất hiện 1 cửa sổ, nhưng thay vì cửa sổ có chức nằng mở file có sẵn thì thay thế bằng cửa sổ có chức năng lưu file vào thư mục nào? Còn nếu tự động lưu thì lưu vào thư mục chứa file của cad đang dùng lấy toạ độ. Cảm ơn Thiệp đã giúp đỡ!


  14. Chào CongHoan, Thiep muốn tìm lại lisp gtd.lsp mà Hoan load được là của tác giả nào mà không thấy. Hoan chỉ giùm nhé

    Bây giờ Thiep chỉnh lại lisp ấy đây:

    (defun c:gtd (/ ST fn f x1 y1)
     (setq fn (getfiled "Chon file ghi toa do: " "D:/" "tdo" 8))
     (setq f (open fn "a"))
     (setq ST 1)
     (while (setq pt (getpoint "Toa do diem : "))
       (setq x1 (rtos (car pt) 2 4)
      y1 (rtos (cadr pt) 2 4))
       (write-line (strcat (itoa ST) "\t" x1 "\t" y1) f)
       (setq ST (1+ ST))
       (terpri)
     )
     (close f)
     (print)
    )

    Chào Thiêp! cảm ơn vì một lần nữa đã giúp mình.

    Cái này mình sưu tầm được hình như không phải ở cadviet.

    Lisp Thiep sửa chạy tốt lắm nhưng mình thấy khi bắt đầu là mở mốt file .tdo. Mình nghĩ để cho nó lưu file thì sẽ hay hơn , vì mối lần làm như thế mình cần một file mới mình nghĩ lưu một file sẽ hay hơn mở một file đã có.

    Chúc thiep sức khoẻ!


  15. Mình tìm trên diễn đàn cái lisp ghi toa độ mà chưa tìm được cái đúng ý mình, Nhờ các bác sửa giúp mình cái lisp này với, hiện mình đang dùng nhưng lại có 2 điểm bấc tiện thế này:

    1. Nó tự động lưu file .tdo vào nơi nào đó tuỳ thích, có lúc tìm hoài chẳng thấy luôn.

    2. Mỗi lần kích điểm thì phải đặtt tên điểm, mình muốn nó tự đông nhảy từ 1 sau đó lên 2 rồi 3.4.5.6...

    Mình up file không được đành coppy code lê nhé:

    (defun c:gtd()

    (setq file (getstring T "Ten file toa do : "))

    (setq tenf (strcat file ".tdo"))

    (setq f (open tenf "a"))

    (setq ST1 (getstring "Ten diem : "))

    (setq pt1 (getpoint "Toa do diem : "))

    (while (/= pt1 nil)

    (print)

    (setq x1 (car pt1) y1 (cadr pt1))

    (setq xx1 (rtos x1 2 4) yy1 (rtos y1 2 4))

    (write-line (strcat ST1 "\t" xx1 "\t" yy1) f)

    (setq ST1 (getstring "Ten diem : "))

    (setq pt1 (getpoint "Toa do diem : "))

    )

    (close f)

    (princ)

    )

    (prompt "\nTD : Ghi toa do diem ra file")


  16. Thiep dùng cad2007 giống nhau, Tiếc là mình không đưa ảnh như NATACA được, bạn xem ảnh động sẽ thấy lisp VBU làm việc tại máy Thiep, link sau đây:

    http://www.cadviet.com/upfiles/2/vetbun.gif

    Ngoài ra ý tưởng 2 của Hoan, Thiep cũng đã test xong:

    ;;;---------------------------------
    ;;; LISP vet bun (ver 2.0), COPYRIGHT BY THIEP
    ;;; FREE FROM CADVIET.COM-----------
    (defun GiaoDT (e1 e2 / ob1 ob2 g L n kq)
     (setq	ob1 (vlax-ename->vla-object e1)
    ob2 (vlax-ename->vla-object e2)
    g   (vlax-variant-value
          (vla-IntersectWith ob1 ob2 acExtendnone)
        )
     )
     (if (/= (vlax-safearray-get-u-bound g 1) -1)
       (setq L (vlax-safearray->list g))
     )
     (setq n 0)
     (repeat (/ (length L) 3)
       (setq kq
       (append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
    	   kq
       )
       )
       (setq n (+ n 3))
     )
     kq
    )
    (defun LWP (Lpoint *Model* / PntArr)
     (setq	PntArr (vlax-make-safearray
    	 vlax-vbDouble
    	 (cons 0 (1- (length Lpoint)))
           )
     )
     (vlax-safearray-fill PntArr Lpoint)
     (vla-AddLightWeightPolyline *Model* PntArr)
    )
    ;;;-----------------------
    (defun SS-enlst	(ss / c L)
     (setq c -1)
     (repeat (sslength ss)
       (setq L (cons (ssname ss (setq c (1+ c))) L))
     )
     (reverse L)
    )
    ;;;----------------------
    (defun taoRay (ModelS poR1 poR2)
     (vla-Addray
       ModelS
       (vlax-3d-point poR1)
       (vlax-3d-point poR2)
     )
    )
    
    				;-----------------------
    (defun TextTaluy (model k po h ang / obj)
     (setq	obj (vla-AddText
          *Model*
          (strcat "1:" (rtos k 2 1))
          (vlax-3d-point po)
          h
        )
     )
     (vla-put-Alignment obj acAlignmentTopCenter)
     (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
     (vla-put-Rotation obj ang)
     (vla-put-layer obj "vetbun")
    )
    ;;;---------------------
    (defun SAVE_MODE ()
     (command "UCS" "W" "")
     (setq	OLD_OSMODE    (getvar "OSMODE")
    OLD_CECOLOR   (getvar "CECOLOR")
    OLD_AUTOSNAP  (getvar "AUTOSNAP")
    OLD_ORTHOMODE (getvar "ORTHOMODE")
     )
     (setvar "cmdecho" 0)
     (setvar "plinegen" 1)
    
    )
    (defun RESTORE ()
     (setvar "osmode" OLD_OSMODE)
     (setvar "AUTOSNAP" OLD_AUTOSNAP)
     (setvar "ORTHOMODE" OLD_ORTHOMODE)
     (setvar "CECOLOR" OLD_CECOLOR)
     (setvar "cmdecho" 1)
    )
    ;;;--------------------------
    (defun DXF (code en) (cdr (assoc code (entget en))))
    ;;; -------------------------------
    (defun existLinetype (doc LineTypeName / item loaded)
     (vlax-for item (vla-get-linetypes doc)
       (if	(= (strcase (vla-get-name item)) (strcase LineTypeName))
         (setq loaded T)
       )
     )
    )
    ;;;------loadLinetype
    (defun loadLinetype (doc LineTypeName FileName)
     (if (and
    (not (existLinetype doc LineTypeName))
    (vl-catch-all-error-p
      (vl-catch-all-apply
        'vla-load
        (list
          (vla-get-Linetypes doc)
          LineTypeName
          FileName
        )
      )
    )
         )
       nil
       T
     )
    )
    ;;;--------------------------
    (defun lstvexter (obj / lstp)
     (setq	lstp (vlax-safearray->list
           (vlax-variant-value (vla-get-Coordinates obj))
         )
     )
     (setq n 0)
     (repeat (/ (length lstp) 2)
       (setq kqp
       (cons (list (nth n lstp) (nth (+ n 1) lstp) 0.0)
    	 kqp
       )
       )
       (setq n (+ n 2))
     )
     kqp
    )
    ;;;--------------------------
    (vl-load-com)
    
    ;;;================================MAIN=============================
    (DEFUN c:vbu (/	     ActDoc *Model*	  *layer*	en     ss
          p1     Pa	    Pb	   p1	  p11	 p2	p21    p3
          p4     objD   enD	   objR1  objR2	 enR1	enR2   pin1
          pin2   pe1    pe2	   objL2  objL1	 enL1	enL2   lay
          an1    an2    pTex1  pTex2  i	 ss	lop    upp
          un     ofp    intP   enLWP  LenLWP Lllup	LenGH  lstLWp
          Lint   Len    lstp objL2
         )
     (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
    *Model*	(vla-get-ModelSpace ActDoc)
    *layer*	(vla-get-Layers ActDoc)
     )
     (vla-StartUndoMark ActDoc)
     (SAVE_MODE)
     (setvar "osmode" 0)
     (loadLinetype ActDoc "HIDDEN" "acad.lin")
     (if (not (setq enlay (tblobjname "layer" "vetbun")))
       (progn
         (setq lay (vla-add *layer* "vetbun"))
         (vla-put-color lay acMagenta)
         (vla-put-Linetype lay "HIDDEN")
       )
       (progn
         (setq lay (vlax-ename->vla-object enlay))
         (setq lay (vla-add *layer* "vetbun"))
         (vla-put-color lay acMagenta)
         (vla-put-Linetype lay "HIDDEN")
       )
     )
     (princ "Chon cac curve be mat nao vet: ")
    
     (setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
     (if (null k_Thiep1)
       (setq
         k_Thiep1 (getreal "\nChon goc doc nao vet ben PHAI (mau so): ")
       )
     )
     (if (null k_Thiep2)
       (setq
         k_Thiep2 (getreal "\nChon goc doc nao vet ben TRAI (mau so): ")
       )
     )
     (if (null d_Thiep)
       (setq d_Thiep (getreal "\nChieu sau nao vet: "))
     )
     (if (null hei_Thiep)
       (setq hei_Thiep (getreal "\nChon chieu cao chu: "))
     )
     (setq	Len (SS-enlst ss)
    i   0
     )
     (foreach en Len
       (if	(and (eq (dxf 0 en) "LWPOLYLINE")
         (eq (strcase (dxf 8 en)) "DUONGTUNHIEN")
    )
         (setq LenLWP (cons en LenLWP))
       )
     )
     (foreach enLWP LenLWP
       (redraw enLWP 3)
       (setq objLW	(vlax-ename->vla-object enLWP)
      Lllup	(ACET-ENT-GEOMEXTENTS enLWP)
      lop	(car Lllup)
      upp	(cadr Lllup)
      un	(getvar "viewsize")
      ofp	(list (/ (+ (car upp) (car lop)) 2)
    	      (- (cadr lop) un)
    	      0.0
    	)
       )
       (setq pA (vlax-curve-getStartPoint enLWP)
      pB (vlax-curve-getEndPoint enLWP)
       )
       (if	(< (car pA) (car pB))
         (progn
    (setq flag -0.1)
    (setq disoff d_Thiep)
         )
         (progn
    (setq flag 0.1)
    (setq disoff (- d_Thiep))
         )
       )
       (setq objLW1 (car (vlax-safearray->list
    		(vlax-variant-value (vla-offset objLW flag))
    	      )
    	 )
       )
       (setq lstLWp (lstvexter objLW1)
    				;(setq lstP	(ACET-GEOM-VERTEX-LIST enLWP)
      ss	 (ssget "F" lstLWp)
      LenGH	 (SS-enlst ss)
      kqp	 nil
       )
       (vla-delete objLW1)
       (foreach enGH LenGH
         (if (and (eq (DXF 0 enGH) "LINE")
           (setq intP (car (GiaoDT enGH enLWP)))
      )
    (progn
      (setq Lint (cons intP Lint))
      (setq kq nil)
    )
         )
       )
       (setq Lint
       (vl-sort
         Lint
         '(lambda (e1 e2) (< (car e1) (car e2)))
       )
       )
       (setq p1  (car Lint)
      p2  (cadr Lint)
      p11 (list (+ (car p1) k_Thiep1) (- (cadr p1) 1) 0.0)
      p21 (list (- (car p2) k_Thiep2) (- (cadr p2) 1) 0.0)
      an1 (angle p1 p11)
      an2 (angle p2 p21)
       )
    ;;;================
       (vla-offset objLW disoff)
       (setq enD (entlast))
       (setq objR1	(taoRay *Model* p1 p11)
      objR2	(taoRay *Model* p2 p21)
       )
       (setq enR1 (vlax-vla-object->ename objR1)
      enR2 (vlax-vla-object->ename objR2)
       )
       (setq PA (vlax-curve-getStartPoint enD)
      PB (vlax-curve-getEndPoint enD)
       )
       (setq pin1 (car (giaoDT enR1 enD))
      p11  (car (giaoDT enR1 enLWP))
      pin2 (car (giaoDT enR2 enD))
      p22  (car (giaoDT enR2 enLWP))
      pinR (car (giaoDT enR1 enR2))
      kq   nil
       )
       (cond ((/= p1 p11)
       (setq p1 p11)
      )
      ((/= p2 p22)
       (setq p2 p22)
      )
       )
       (setvar "osmode" 0)
       (if	(< (car pin1) (car pin2))
         (Progn
    (vla-delete objR1)
    (vla-delete objR2)
    (if (< (car PA) (car PB))
      (progn
        (VL-CMDF "_.break" enD pin2 pin2)
        (setq ss (ssname (ssget pin2) 0))
        (entdel ss)
        (setq pe1 (list (+ (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
    	  pe2 (list (+ (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
    	  pe3 (list (- (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
    	  pe4 (list (- (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
        )
        (setq enD (ssname (ssget pin1) 0))
        (VL-CMDF "_.break" enD pin1 pin1)
        (entdel (ssname (ssget "F" (list pe3 pe4)) 0))
        (setq enD (ssname (ssget "F" (list pe1 pe2)) 0))
      )
      (progn
        (VL-CMDF "_.break" enD pin1 pin1)
        (setq ss (ssname (ssget pin1) 0))
        (entdel ss)
        (setq pe1 (list (+ (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
    	  pe2 (list (+ (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
    	  pe3 (list (- (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
    	  pe4 (list (- (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
        )
        (setq enD (ssname (ssget pin2) 0))
        (VL-CMDF "_.break" enD pin2 pin2)
        (entdel (ssname (ssget "F" (list pe1 pe2)) 0))
        (setq enD (ssname (ssget "F" (list pe3 pe4)) 0))
      )
    )
    (setq Lp    (list (car p1)
    		  (cadr p1)
    		  (car pin1)
    		  (cadr pin1)
    	    )
          objL1 (LWP Lp *Model*)
          enL1  (vlax-vla-object->ename objL1)
    )
    (setq Lp    (list (car p2)
    		  (cadr p2)
    		  (car pin2)
    		  (cadr pin2)
    	    )
          objL2 (LWP Lp *Model*)
          enL2  (vlax-vla-object->ename objL2)
    )
    (vl-cmdf ".pedit" "m" enL1 end enL2 "" "j" "" "")
    (setq lineNV (vlax-ename->vla-object (entlast)))
         )
    
         (Progn
    (vla-delete objR1)
    (vla-delete objR2)
    (entdel enD)
    (setq Lp (list (car p1)
    	       (cadr p1)
    	       (car pinR)
    	       (cadr pinR)
    	       (car p2)
    	       (cadr p2)
    	 )
    )
    (setq lineNV (LWP Lp *Model*))
    (setq pin1 pinR
          pin2 pinR
    )
         )
    
       )
    
       (vla-put-layer lineNV "vetbun")
       (vla-put-color lineNV acbylayer)
       (vla-put-LinetypeScale lineNV 2)
       (vla-put-LinetypeGeneration lineNV T)
    
       (setq pTex1	(polar (acet-geom-midpoint p1 pin1)
    	       (- an1 (/ pi 2))
    	       (/ hei_Thiep 2)
    	)
       )
       (TextTaluy *Model* k_Thiep1 pTex1 hei_Thiep an1)
       (setq pTex2	(polar (acet-geom-midpoint p2 pin2)
    	       (+ an2 (/ pi 2))
    	       (/ hei_Thiep 2)
    	)
       )
       (TextTaluy *Model* k_Thiep2 pTex2 hei_Thiep (+ an2 pi))
       (setq Lint	 nil
      Len	 nil
      lstp	 nil
      LenLWP (cdr LenLWP)
       )
     (vla-Regen ActDoc acActiveViewport)
     )
    
     (vla-ZoomExtents (vlax-get-acad-object))
     (RESTORE)
     (vla-EndUndoMark ActDoc)
     (princ "\nChuc cac ban thanh cong. Thiep")
     (princ)
    )
    ;;;=============================================================================
    
    =================================
    ;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
    (defun c:khd ()
     (setq	k_Thiep1 (cond (k_Thiep1)
    	       (5)
    	 )
     )
     (setq oldk_Thiep1 k_Thiep1)
     (setq
       k_Thiep1 (getreal
           (strcat "\nChon goc doc nao vet ben PHAI (mau so) <"
    	       (rtos oldk_Thiep1 2 1)
    	       "> : "
    
           )
         )
     )
     (if (null k_Thiep1)
       (setq k_Thiep1 oldk_Thiep1)
     )
     (setq	k_Thiep2 (cond (k_Thiep2)
    	       (5)
    	 )
     )
     (setq oldk_Thiep2 k_Thiep2)
     (setq
       k_Thiep2 (getreal
           (strcat "\nChon goc doc nao vet ben TRAI (mau so) <"
    	       (rtos oldk_Thiep2 2 1)
    	       "> : "
    
           )
         )
     )
     (if (null k_Thiep2)
       (setq k_Thiep2 oldk_Thiep2)
     )
     (setq	d_Thiep	(cond (d_Thiep)
    	      (5)
    	)
     )
     (setq oldd_Thiep d_Thiep)
     (setq	d_Thiep	(getreal (strcat "\nChieu sau nao vet <"
    			 (rtos oldd_Thiep 2 1)
    			 "> : "
    
    		 )
    	)
     )
     (if (null d_Thiep)
       (setq d_Thiep oldd_Thiep)
     )
     (setq	hei_Thiep (cond	(hei_Thiep)
    		(5)
    	  )
     )
     (setq oldhei_Thiep hei_Thiep)
     (setq	hei_Thiep (getreal (strcat "\nChon chieu cao chu <"
    			   (rtos oldhei_Thiep 2 1)
    			   "> : "
    
    		   )
    	  )
     )
     (if (null hei_Thiep)
       (setq hei_Thiep oldhei_Thiep)
     )
     (prinC "\nBay gio ban co the su dung lenh VBU")
     (princ)
     (c:vbu)
    )

    Lisp yêu cầu chọn các mằt cắt địa hình (thuộc lớp DUONGTUNHIEN) và các đường giới hạn (LINE) cùng 1 lúc

    Mình cũng chẳng hiều tại sao mình chạy cái đó bị lỗi nữa nhưng cái ý lisp thứ hai thì chạy tốt lắm, tạm thời mình chưa thấy lỗi nào cả!Rất tiết nút Thank chỉ kích được một lần. Cảm ơn thiêp nhiều nha!


  17. Không phải lệnh VB, mà là lệnh VBU. Nhưng Cad đã không hiểu lệnh rồi mà sao vẫn yêu cầu "Chon goc doc nao vet ben PHAI (mau so):"....???

    Cái này mình biết rồi, mình chỉ đổi lệnh lại để cho tiện sử dụng thôi. Mình cũng chẳng hiểu tại sao không biết lệnh mà lại yêu cầu như thế nửa, mà thiệp test trên cad nào vậy?


  18. Chào Hoan, thiep kiểm tra nhiều lần mà có lỗi gì đâu? khi chọn đối tượng, Hoan nhớ chọn theo kiểu cửa sổ từ phải qua trái, có 5 đối tượng được chọn, gồm 1 pline tự nhiên, 4 line giới hạn. Trong 4 line giới hạn màu vàng, có 2 line cắt qua pline. Điểm cắt này là điểm bắt đầu vẽ đường nạo vét. Sau khi chọn xong nhấn enter, nếu lần đầu khi chạy lisp, lisp sẽ hỏi các thông số. Tiếp tục chọn các mặt cắt khác, khi chọn xong, enter, chọn, enter.... cho đến khi hết mặt cắt, mỏi tay thì ẻnter kết thúc. Còn lisp chọn 1 lần các mặt cắt 1 lúc, Thiep đã viết xong đang test. Hãy đợi đấy nhé.

    Mình cũng chẳng hiểu sao lại lỗi ngư thế nữa, mình test (trên cad2007) nhiều lần mà mà vẫn như thế, mặt cắt đầu tiên chạy OK còn các mặt cắt tiếp theo thì không được. Thiệp xem lại giúp mình nhé. Cảm ơn nhiều!

    Nó báo như thế này:

    Command: AP APPLOAD khd_vbu.lsp successfully loaded.

    Command:

    Command:

    Command: VB 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: UCS

    Current ucs name: *WORLD*

    Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis]

    : W

    Command: VB Unknown command "VB". Press F1 for help.

    Command: Chon cac curve be mat nao vet:

    Select objects: Specify opposite corner: 5 found

    Select objects:

    Chon goc doc nao vet ben PHAI (mau so): 1

    Chon goc doc nao vet ben TRAI (mau so): 1

    Chieu sau nao vet: 1

    Chon chieu cao chu: 1

    Select objects: Specify opposite corner: 5 found

    Select objects: bad argument type: lselsetp nil

    File mình test bị lối nè: http://www.cadviet.com/upfiles/2/tnct_5.dwg


  19. Hoan có chắc là quét luôn đường trồng cỏ của Hoan thì lisp bị lỗi không? Lisp này chỉ xử lý 1 đường tự nhiên là LWPOLYLINE và 2 hai đường giới hạn là LINE cắt qua đường tự nhiên. còn 2 line là đường trồng cỏ không cắt qua đường tự nhiên thì không sao.

    Còn Hoan muốn lisp chọn hết 1 lúc các loại đường trên một lúc thì cũng sẽ có lisp, nhưng Thiep e rằng nếu số lượng mặt cắt quá lớn, hàng trăm, ngàn cái, thì lisp sẽ chậm và nếu có 1 mặt cắt nào đó không phù hợp với yêu cầu của Lisp (như Thiep đã từng phân tich có 5 trường hợp xảy ra) thì lisp sẽ báo lỗi ngay.

    Chào thiệp!

    File mình test bị lỗi nè: http://www.cadviet.com/upfiles/2/tnct_4.dwg

    không biết mình dùng cad 2007 có ảnh hưởng gì không nữa.

    Nếu đúg như thiệp nói thì cái này OK rồi, còn cái mà quét một lần tấc cả các mặt cắt thì bao giờ rãnh thì thiep làm cũng được, còn việc chọn nhiều mặt cắt bị lỗi thì không sao, mình có thể giới hạn tối đa 100, 50 thậm chí 10 mặt cắt một lần cũng được mà. Cảm ơn thiep nhiều!


  20. Gửi Hoan, bây giờ thì Ý tưởng của Hoan đã được hoàn thiện bằng lisp sau đây. Khi chọn đối tượng, Hoan phải chọn cả đường địa hình tự nhiên và cả đường giới hạn cùng 1 lúc, cứ tiếp tục cho đến hết mặt cắt, enter kết thúc. :bigsmile:

    ;;;---------------------------------
    ;;; LISP vet bun, COPYRIGHT BY THIEP 0918841230
    ;;; FREE FROM CADVIET.COM-----------
    (defun GiaoDT (e1 e2 / ob1 ob2 g L n kq)
     (setq	ob1 (vlax-ename->vla-object e1)
    ob2 (vlax-ename->vla-object e2)
    g   (vlax-variant-value
          (vla-IntersectWith ob1 ob2 acExtendnone)
        )
     )
     (if (/= (vlax-safearray-get-u-bound g 1) -1)
       (setq L (vlax-safearray->list g))
     )
     (setq n 0)
     (repeat (/ (length L) 3)
       (setq kq
       (append (list (list (nth n L) (nth (+ n 1) L) (nth (+ n 2) L)))
    	   kq
       )
       )
       (setq n (+ n 3))
     )
     kq
    )
    (defun LWP (Lpoint *Model* / PntArr)
     (setq	PntArr (vlax-make-safearray
    	 vlax-vbDouble
    	 (cons 0 (1- (length Lpoint)))
           )
     )
     (vlax-safearray-fill PntArr Lpoint)
     (vla-AddLightWeightPolyline *Model* PntArr)
    )
    ;;;-----------------------
    (defun SS-enlst (ss / c L)
     (setq c -1)
     (repeat (sslength ss)
       (setq L (cons (ssname ss (setq c (1+ c))) L))
     )
     (reverse L)
    )
    ;;;----------------------
    (defun taoRay (ModelS poR1 poR2)
     (vla-Addray
       ModelS
       (vlax-3d-point poR1)
       (vlax-3d-point poR2)
     )
    )
    
    ;-----------------------
    (defun TextTaluy (model k po h ang / obj)
     (setq	obj (vla-AddText
          *Model*
          (strcat "1:" (rtos k 2 1))
          (vlax-3d-point po)
          h
        )
     )
     (vla-put-Alignment obj acAlignmentTopCenter)
     (vla-put-TextAlignmentPoint obj (vlax-3d-point po))
     (vla-put-Rotation obj ang)
     (vla-put-layer obj "vetbun")
    )
    ;;;---------------------
    (defun SAVE_MODE ()
    
     (command "Undo" "begin")
     (command "UCS" "W" "")
     (setq	OLD_OSMODE    (getvar "OSMODE")
    OLD_CECOLOR   (getvar "CECOLOR")
    OLD_AUTOSNAP  (getvar "AUTOSNAP")
    OLD_ORTHOMODE (getvar "ORTHOMODE")
     )
     (setvar "cmdecho" 0)
     (setvar "plinegen" 1)
    
    )
    (defun RESTORE ()
     (command "Undo" "end")
     (setvar "osmode" OLD_OSMODE)
     (setvar "AUTOSNAP" OLD_AUTOSNAP)
     (setvar "ORTHOMODE" OLD_ORTHOMODE)
     (setvar "CECOLOR" OLD_CECOLOR)
     (setvar "cmdecho" 1)
    )
    ;;;--------------------------
    (defun DXF (code en) (cdr (assoc code (entget en))))
    ;;; -------------------------------
    (defun existLinetype (doc LineTypeName / item loaded)
     (vlax-for item (vla-get-linetypes doc)
       (if (= (strcase (vla-get-name item)) (strcase LineTypeName))
         (setq loaded T)
       )
     )
    )
    ;;;------loadLinetype
    (defun loadLinetype (doc LineTypeName FileName)
     (if (and
           (not (existLinetype doc LineTypeName))
           (vl-catch-all-error-p
             (vl-catch-all-apply
               'vla-load
               (list
                 (vla-get-Linetypes doc)
                 LineTypeName
                 FileName
               )
             )
           )
         )
       nil
       T
     )
    )
    ;;;--------------------------
    (vl-load-com)
    
    ;;;================================MAIN=============================
    (DEFUN c:vbu (/	ActDoc *Model*	     *layer*	   en	  ss	 p1
    	Pa     Pb     p1     p11    p2	   p21	  p3	 p4
    	objD   enD    objR1  objR2  enR1   enR2	  pin1	 pin2
    	pe1    pe2    objL2  objL1  enL1   enL2	  lay	 an1
    	an2    pTex1  pTex2  i	    ss	   Len	  lop	 upp
    	Lint   intP   enLWP
           )
     (setq	ActDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
    *Model*	(vla-get-ModelSpace ActDoc)
    *layer*	(vla-get-Layers ActDoc)
     )
     (vla-StartUndoMark ActDoc)
     (SAVE_MODE)
     (loadLinetype ActDoc "HIDDEN" "acad.lin")
     (if (not (tblsearch "layer" "vetbun"))
       (progn
         (setq lay (vla-add *layer* "vetbun"))
         (vla-put-color lay acMagenta)
         (vla-put-Linetype lay "HIDDEN")
       )
     )
     (princ "Chon cac curve be mat nao vet: ")
     (While
       (setq SS (ssget '((0 . "LWPOLYLINE,LINE"))))
        (if (null k_Thiep1) (setq k_Thiep1 (getreal  "\nChon goc doc nao vet ben PHAI (mau so): ")))
        (if (null k_Thiep2) (setq k_Thiep2 (getreal  "\nChon goc doc nao vet ben TRAI (mau so): ")))
        (if (null d_Thiep) (setq d_Thiep (getreal  "\nChieu sau nao vet: ")))
        (if (null hei_Thiep) (setq hei_Thiep (getreal  "\nChon chieu cao chu: ")))
        (setq Len (SS-enlst ss)
       i   0
        )
        (foreach en Len
          (if (eq (dxf 0 en) "LWPOLYLINE")
     (progn
       (redraw en 3)
       (setq enLWP en
    	 OBcur (vlax-ename->vla-object enLWP)
       )
       (vla-getboundingbox OBcur 'minpoint 'maxpoint)
       (setq lop (vlax-safearray->list minpoint)
    	 upp (vlax-safearray->list maxpoint)
    	 un  (getvar "viewsize")
    	 ofp (list (/ (+ (car upp) (car lop)) 2)
    		   (- (cadr lop) un)
    		   0.0
    	     )
       )
     )
          )				;end if
        )
        (foreach en Len
          (if (not (eq (dxf 0 en) "LWPOLYLINE"))
     (progn
       (setq intP (car (GiaoDT en enLWP)))
       (if intP
         (setq Lint (cons intP Lint))
       )
     )
          )
        )
        (setq Lint
        (vl-sort
          Lint
          '(lambda (e1 e2) (< (car e1) (car e2)))
        )
        )
        (setvar "osmode" 32)
        (setq p1  (car Lint)
       p2  (cadr Lint)
       p11 (list (+ (car p1) k_Thiep1) (- (cadr p1) 1) 0.0)
       p21 (list (- (car p2) k_Thiep2) (- (cadr p2) 1) 0.0)
       an1 (angle p1 p11)
       an2 (angle p2 p21)
        )
    ;;;================
        (vl-cmdf ".offset" d_Thiep enLWP ofp "")
        (setq enD (entlast))
        (setq objR1 (taoRay *Model* p1 p11)
       objR2 (taoRay *Model* p2 p21)
        )
        (setq enR1	(vlax-vla-object->ename objR1)
       enR2	(vlax-vla-object->ename objR2)
        )
        (setq PA (vlax-curve-getStartPoint enD)
       PB (vlax-curve-getEndPoint enD)
        )
        (setq pin1	(car (giaoDT enR1 enD))
       p11	(car (giaoDT enR1 enLWP))
       pin2	(car (giaoDT enR2 enD))
       p22	(car (giaoDT enR2 enLWP))
       pinR	(car (giaoDT enR1 enR2))
        )
        (cond ((/= p1 p11)
        (setq p1 p11)
       )
       ((/= p2 p22)
        (setq p2 p22)
       )
        )
        (setvar "osmode" 0)
        (if (< (car pin1) (car pin2))
          (Progn
     (vla-delete objR1)
     (vla-delete objR2)
     (if (< (car PA) (car PB))
       (progn
         (VL-CMDF "_.break" enD pin2 pin2)
         (setq ss (ssname (ssget pin2) 0))
         (entdel ss)
         (setq pe1 (list (+ (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
    	   pe2 (list (+ (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
    	   pe3 (list (- (car pin1) 0.1) (+ (cadr pin1) 0.1) 0.0)
    	   pe4 (list (- (car pin1) 0.1) (- (cadr pin1) 0.1) 0.0)
         )
         (setq enD (ssname (ssget pin1) 0))
         (VL-CMDF "_.break" enD pin1 pin1)
         (entdel (ssname (ssget "F" (list pe3 pe4)) 0))
         (setq enD (ssname (ssget "F" (list pe1 pe2)) 0))
       )
       (progn
         (VL-CMDF "_.break" enD pin1 pin1)
         (setq ss (ssname (ssget pin1) 0))
         (entdel ss)
         (setq pe1 (list (+ (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
    	   pe2 (list (+ (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
    	   pe3 (list (- (car pin2) 0.1) (+ (cadr pin2) 0.1) 0.0)
    	   pe4 (list (- (car pin2) 0.1) (- (cadr pin2) 0.1) 0.0)
         )
         (setq enD (ssname (ssget pin2) 0))
         (VL-CMDF "_.break" enD pin2 pin2)
         (entdel (ssname (ssget "F" (list pe1 pe2)) 0))
         (setq enD (ssname (ssget "F" (list pe3 pe4)) 0))
       )
     )
    ;;;end if trong
     (setq Lp    (list (car p1)
    		   (cadr p1)
    		   (car pin1)
    		   (cadr pin1)
    	     )
           objL1 (LWP Lp *Model*)
           enL1  (vlax-vla-object->ename objL1)
     )
     (setq Lp    (list (car p2)
    		   (cadr p2)
    		   (car pin2)
    		   (cadr pin2)
    	     )
           objL2 (LWP Lp *Model*)
           enL2  (vlax-vla-object->ename objL2)
     )
     (vl-cmdf ".pedit" "m" enL1 end enL2 "" "j" "" "")
     (setq lineNV (vlax-ename->vla-object (entlast)))
          )
    ;;;end progn 1
          (Progn
     (vla-delete objR1)
     (vla-delete objR2)
     (entdel enD)
     (setq Lp (list	(car p1)
    		(cadr p1)
    		(car pinR)
    		(cadr pinR)
    		(car p2)
    		(cadr p2)
    	  )
     )
     (setq lineNV (LWP Lp *Model*))
     (setq pin1 pinR
           pin2 pinR
     )
          )
    ;;;end progn 2
        )
    ;;;end if ngoai
        (vla-put-layer lineNV "vetbun")
        (vla-put-color lineNV acbylayer)
        (vla-put-LinetypeScale lineNV 2)
        (vla-put-LinetypeGeneration lineNV T)
    ;;;---tao text----
        (setq pTex1 (polar	(acet-geom-midpoint p1 pin1)
    		(- an1 (/ pi 2))
    		(/ hei_Thiep 2)
    	 )
        )
        (TextTaluy *Model* k_Thiep1 pTex1 hei_Thiep an1)
        (setq pTex2 (polar	(acet-geom-midpoint p2 pin2)
    		(+ an2 (/ pi 2))
    		(/ hei_Thiep 2)
    	 )
        )
        (TextTaluy *Model* k_Thiep2 pTex2 hei_Thiep (+ an2 pi))
        (setq Lint nil
       Len nil)
    
    ;(redraw en 4)
     )
    ;;;end while
     (vla-ZoomExtents (vlax-get-acad-object))
     (RESTORE)
     (vla-EndUndoMark ActDoc)
     (princ "\nChuc cac ban thanh cong. Thiep")
     (princ)
    )
    ;;;-----------------ham dinh thong so k_Thiep, d_Thiep, hei_Thiep
    (defun c:khd ()
     (setq	k_Thiep1	(cond (k_Thiep1)
    	      (5)
    	)
     )
     (setq oldk_Thiep1 k_Thiep1)
     (setq	k_Thiep1	(getreal (strcat "\nChon goc doc nao vet ben PHAI (mau so) <"
    			 (rtos oldk_Thiep1 2 1)
    			 "> : "
    
    		 )
    	)
     )
     (if (null k_Thiep1)
       (setq k_Thiep1 oldk_Thiep1)
     )
    (setq	k_Thiep2	(cond (k_Thiep2)
    	      (5)
    	)
     )
     (setq oldk_Thiep2 k_Thiep2)
     (setq	k_Thiep2	(getreal (strcat "\nChon goc doc nao vet ben TRAI (mau so) <"
    			 (rtos oldk_Thiep2 2 1)
    			 "> : "
    
    		 )
    	)
     )
     (if (null k_Thiep2)
       (setq k_Thiep2 oldk_Thiep2)
     )
    
     (setq	d_Thiep	(cond (d_Thiep)
    	      (5)
    	)
     )
     (setq oldd_Thiep d_Thiep)
     (setq	d_Thiep	(getreal (strcat "\nChieu sau nao vet <"
    			 (rtos oldd_Thiep 2 1)
    			 "> : "
    
    		 )
    	)
     )
     (if (null d_Thiep)
       (setq d_Thiep oldd_Thiep)
     )
     (setq	hei_Thiep (cond	(hei_Thiep)
    		(5)
    	  )
     )
     (setq oldhei_Thiep hei_Thiep)
     (setq	hei_Thiep (getreal (strcat "\nChon chieu cao chu <"
    			   (rtos oldhei_Thiep 2 1)
    			   "> : "
    
    		   )
    	  )
     )
     (if (null hei_Thiep)
       (setq hei_Thiep oldhei_Thiep)
     )
     (prinC "\nBay gio ban co the su dung lisp vbu.lsp")
     (princ)
     (c:vbu)
    )

    Cảm ơn Thiêp nhiều, cái này dùng được 90% rồi.

    Khi dùng mình vấn đề như thế này: Đường giới hạn vét có thêm một đoạn không cắt đường polyline (thực ra nó là đường trồng cỏ) cho nên khi quét, nếu quét luôn nó thì lisp sẽ không hiều. Còn nếu mình pick từng đường một thì lisp chạy được nhưng cũng có một số mặt cắt bị lỗi nhưng làm thế này thì nó sẽ lâu hơn là mỗi mặt cắt mình quét luôn 1lần. Nếu thiêp sữa được để quét một lần càng tốt không thì mình sẽ pick từng đường một cũng được

    Còn ý tưởng của mình là thay vì mình quét từng mặt cắt mình sẽ quét tấc cả các mặt cắt luôn không biết như thế có khó qúa không? Nếu không thể quét tấc cả thì mình quét từng mặt cắt như thế cũng nhanh lằm rồi. Chúc sức khỏe! file test: http://www.cadviet.com/upfiles/2/tnct_3.dwg


  21. À, thiep thấy rồi, đường giới hạn nạo vét là 2 cái "râu cá trê" line màu vàng đặt trong lớp "giới hạn vét" phải không?

    Thiep hỏi tiếp: đường nạo vét, Hoan có muốn là nét đứt màu tím không?

    đường Cái Mép - Thị Vải hằng năm có bị bồi lắng hay sao mà phải nạo vét hả H?

    Thiep mới ở CPC về hơn 10 ngày.

    Uh, đúng là hai cái râu đó nhưng mà lại có hai cái râu phía trên làm mình khó quét nè, hay là mình nối nó lại thành một sau đó rồi mới dùng lisp được không hả thiep, mà như thế thì đường giới hạn vét cũng là polyline không biết thiep nghĩ sao!

    Còn đường Cái Mép, cái này là vét hữu cơ trên đường chứ không phải nạo vét lòng sông thiep a? Thiep đi CPC sao về nhanh thế? Đi về có còn nguyên vẹn không thế! :bigsmile:


  22. Chào a Thiêp!

    Thiệp hiểu sai ý của mình rồi, ý tưởng của mình cũng làm công tác nạo vét như cũ thôi, kết quả tạo thành cũng như thế không có gì khác nhưng mà trình tự thực hiện thì nhanh hơn. Nó như thế này:

    Mình có rất nhiều mặt cắt ngang chi tiết, trên mỗi mặt cắt mình có 1 đường tự nhiên(polyline) và hai đường giới hạn vét (line), hai đường giới hạn vét cắt đường tự nhiên tại hai điểm ( tạm gọi là điểm A và điểm :bigsmile:. Sau khi chạy lisp, nhập chiều sâu vét, mái dốc bên trái, bên phải (y như cũ), sau đó quét chọn tấc cả các mặt cắt (có cả đường tự nhiên và đường giới hạn vét). ứng với mỗi đường tự nhiên (polyline) và hai đường giới hạn vét thì lisp sẽ cho mình một đường nạo vét. Mình thấy đượn như thế này thì công tác nạo vét sẽ cực kỳ nhanh nhưng lại sợ ngoài khả năng của lisp. Chúc anh em diễn đàn một tuần làm việc vui vẽ!

    Mình định up file lên mà up hoai chẳng được, Thiệp xem file cad hôm trứơc của Hoan cũng được, bên trái là phần trước khi chạy lisp, bên phải là phần sau khi chạy lisp.

×