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

nguyentienthanhddksct

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

    74
  • Đã tham gia

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

  • Ngày trúng

    1

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


  1. Hề hề hề,

    Dùng thử cái này coi sao. Nếu chưa ưng ý thì hãy so sánh nó với cái lisp lần trước mình sửa để thấy được những sự khác sau giữa 2 lisp. Từ đó suy luận ra cách sửa để làm cho nó phù hợp với yêu cầu của bạn, Trong quá trình tự sửa nếu có gì trục trặc thì post lên mình sẽ hướng dẫn . 

    Chúc thành công.

    http://www.4shared.com/file/CU6lwHnnce/kh__1_.html

    bác phamthanhbinh sửa giúp em đối tượng text ở trục X như trong hình với ạ

     

    http://upfile.vn/jsFCNrBCKVBC/drawing1-dwg.html

     

    em cám ơn a.


  2. Không biết có là bản cad này lỗi không mở được hay là nó ở CAD 2017 mà mình  mở trên cad2015 không được:

    bạn nào có cad 2017 thử mở xem được, nếu mở được save lại về cad2004 giùm mình với. mình cám ơn.

    http://www.mediafire.com/download/kf27oqgktvu8qva/1.dwg

    http://www.mediafire.com/download/an47ncdhqacdh55/2.dwg


  3. Bản vẽ của bạn đây.

    http://www.cadviet.com/upfiles/3/71162_001002_dem_tau__bich_neo_l.dwg

    http://www.cadviet.com/upfiles/3/71162_024027_thep_ban_mat_cau_l.dwg

    http://www.cadviet.com/upfiles/3/71162_038039_coc_btust_d700_l41m_l.dwg

    PS: Trên CADViet có một số Lisp dùng để phá Minsert tuy nhiên vẫn có những hạn chế nhất định. Ví dụ:

    1, Mỗi lần chỉ phá được 1 Minsert

    2, Minsert bị phá ở dạng Block muốn chỉnh sửa lại phải dùng lệnh Explode để phá block đó ra. Tuy nhiên nếu trong block đó còn tồn tại hàng nghìn đối tượng Minsert khác thì khóc mất. Lại phải chọn từng cái Minsert một để phá, chắc đến tết cũng xong  :P  :P  :P

    3, Cũng có nhiều người xóa luôn cái Minsert trong bản vẽ và thay thế bằng cái block cùng tên mà không cần phá. Tuy nhiên cách này chỉ phù hợp khi block đó có trong bản vẽ (một số trường hợp không có đâu nhé) và block đó không có đối tượng con là Minsert khác.

    4, ......

    Để khắc phục những nhược điểm trên tôi đã viết xong 1 Lisp tự động tìm kiếm và phá cho đến khi nào không còn đối tượng là Minsert trong bản vẽ nữa thì thôi. Tuy nhiên sẽ không Post ngay Lisp đó mà xin mời các bác thử sức với bản vẽ này để thấy việc phá hết tất cả các Minsert có trong bản vẽ cũng tương đối lâu.

    http://www.cadviet.com/upfiles/3/71162_minsert.dwg

     

     

    Mình không biết viết Lsp nên không giám múa rìu qua mắt thợ. mình làm theo cách của mình, bạn xem phá như vậy có được ko nhé: (time = chưa đến 1 phút)

    http://www.cadviet.com/upfiles/3/68278_711621_minsert.dwg

    • Vote tăng 2

  4. Lisp đã sửa theo các góp ý từ bài #14 đến #16.

    
    
    ;28/5/2013. Doan Van Ha -CadViet.com
    ;Co 3 kieu Trim:
    ;1). Trim theo Phia: pick diem phia nao thi Trim phia do (tuong tu offset).
    ;2). Trim doan Ngan.
    ;3). Trim doan Dai.
    ;Khong Trim cac truong hop: doi tuong la duong kin ; giao nhau tai hon 1 diem ; giao nhau bieu kien.
    (defun C:HA( / ent0 ent ent2 ss ento lstg lst len1 len2 objlst typ)
     (vl-load-com) (command "undo" "be") (setq cmd (getvar "cmdecho") osm (getvar "osmode"))
     (if
      (and
       (princ "\nChon 1 doi tuong dao cat...")
       (setq ss (ssget ":S" '((0 . "Line,Polyline,Lwpolyline,Spline,Arc"))))
       (setq ent0 (ssname ss 0))
       (princ "\nChon cac doi tuong bi cat...")
       (setq ss (ssget '((0 . "Line,Polyline,Lwpolyline,Spline,Arc")))))
      (progn
       (initget "N D") (setq typ (getpoint "Pick phia can Trim hoac chon kieu Trim [doanNgan/doanDai] <N>: "))
       (if (not typ) (setq typ "N"))
       (setvar "cmdecho" 0) (setvar "osmode" 0)
       (setq objlst (mapcar 'vlax-ename->vla-object (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssadd ent0 ss)))))))
       (command "zoom" "w" (setq pll (car (LM:ListBoundingBox objlst))) (setq pur (cadr (LM:ListBoundingBox objlst))))
       (if (listp typ) 
        (progn
         (command "offset" (* (getvar "viewsize") 1E-6) ent0 typ "")
         (setq ento (entlast))))
       (foreach ent1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (setq lstg (HA:Giao (vlax-ename->vla-object ent0) (vlax-ename->vla-object ent1) acExtendNone))
        (if (and (= (length lstg) 1) (not (equal (car lstg) (vlax-curve-getStartPoint ent1) 1E-3)) (not (equal (car lstg) (vlax-curve-getEndPoint ent1) 1E-3)))
         (progn
     (setq lst (HA:GetNewEnt12 ent1 pll pur (car lstg)))
          (setq len1 (HA:LenCur (setq ent1 (car lst))) len2 (HA:LenCur (setq ent2 (cadr lst))))
          (cond
           ((or (and (= typ "N") (> len1 len2)) (and (= typ "D") (< len1 len2))) (entdel ent2))
      ((or (and (= typ "N") (< len1 len2)) (and (= typ "D") (> len1 len2))) (entdel ent1))
           ((listp typ)
            (if (HA:Giao (vlax-ename->vla-object ento) (vlax-ename->vla-object ent1) acExtendNone)
          (entdel ent1)
        (entdel ent2)))))))
       (if ento (entdel ento))))
     (setvar "cmdecho" cmd) (setvar "osmode" osm) (command "zoom" "p") (command "undo" "e") (princ))
    (defun HA:GetNewEnt12(ent pll pur pt / typ1 ss1 ss2 entlst)
     (setq typ1 (cdr (assoc 0 (entget ent))))
     (setq ss1 (ssget "c" pll pur '((0 . "POLYLINE"))))
     (command ".break" ent pt pt)
     (if (equal typ1 "POLYLINE")
      (progn
       (setq ss2 (ssadd))
       (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "c" pll pur '((0 . "POLYLINE"))))))
        (if (not (ssmemb ent ss1))
         (ssadd ent ss2))
       (setq entlst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss2))))
       (list (car entlst) (cadr entlst))))
      (list ent (entlast))))
    (defun HA:LenCur(ent)
     (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
    (defun HA:Giao(obj1 obj2 mode / l r)
     (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
     (repeat (/ (length l) 3)
      (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
     r)
    (defun LM:ListBoundingBox(objlst / l1 l2 ll ur)
     (foreach obj objlst
      (vla-getboundingbox obj 'll 'ur)
      (setq l1 (cons (vlax-safearray->list ll) l1) l2 (cons (vlax-safearray->list ur) l2)))
      (mapcar (function (lambda(a B) (apply 'mapcar (cons a B)))) '(min max) (list l1 l2)))
     

    Mình load lisp này trên cad 2010 thì báo lỗi này:

    Command: ; error: syntax error

    Mr Ha xem là lỗi gì vậy?

    Thanks!


  5. Hoá ra POLYLINE hay LWPOLYLINE là ở biến PLINETYPE, chứ cad 2004 hay 2007... thì không quan trọng.

    Bạn check 2004 với Plinetype=0, tôi check 2004 với plinetype=1 nên khác nhau. Ái dà, cái này thì phải xem lại các lisp cũ thôi, kẻo nó lỗi hết.

    Nếu có lỗi thì bạn thông báo cho mọi người để cả nhà cùng chữa hỏa. để nhà nước khỏi mất tiền để xây cho anh em ta căn biệt thự bằng đá phiến.

    Nhân tiện cho mình hỏi luôn. Lisp đang chỉ thực hiện khi là LWPOLYLINE giờ muốn nó thực hiện luôn với POLYLINE thì làm thế nào.

    VD lisp này của Mr. PhamThanhBinh. với POLYLINE thì ko thực hiện được

    ;; free lisp from cadviet.com
    ;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63126&pid=195881&st=0entry195881
    
    (defun c:gcoor (/ oldos k k1 p pl pls1 pmin pmax plst sc sh p1el ss1 ssl1 ssl2)
    (Init)
    (vl-load-com)
    (command "undo" "be")
    (setq oldos (getvar "osmode"))
    (setvar "osmode" 0)
    ;;; Ve duong bao
    ;;;(command "pline")
    ;;;(While (setq p (getpoint "\n chon lan luot cac dinh cua duong bao"))
    ;;;	(command p)
    ;;;)
    ;;;(command "c")
    (setq pl (car (entsel "\n Pick chon duong bao " ))
      pls1 (acet-ent-geomextents pl)
      pmin (list (* (1- (fix (/ (caar pls1) k1))) k1) (* (1- (fix (/ (cadar pls1) k1))) k1))
      pmax (list (* (1+ (fix (/ (caadr pls1) k1))) k1) (* (1+ (fix (/ (cadadr pls1) k1))) k1))
    )
    ;;;;;;Tao danh sach diem grid
    (setq plst (list pmin)
         	sc 1)
    (while (<= (+ (car pmin) (* sc k1)) (car pmax))
     	(setq p (list (+ (car pmin) (* sc k1)) (cadr pmin))
        	plst (append plst (list p))
        	sc (1+ sc)
     	)
    )
    (foreach p plst
     	(setq sh 1)
     	(while (<= (+ (cadr p) (* sh k1)) (cadr pmax))
      	(setq p1 (list (car p) (+ (cadr p) (* sh k1)))
                     	plst (append plst (list p1))
                     	sh (1+ sh)
      	)
    )
    )
    plst
    ;;;;;;;;;;; Tao grid
    (setq el (entlast)
         	ss1 (ssadd))
    (foreach p plst
    (xy p)
    )
    ;;;; Loc grid
    (while (setq el (entnext el))
    (setq ss1 (ssadd el ss1))
    )
    (setq ssl1 (acet-ss-to-list ss1))
    (setq ppl (list)
    par 0
    pob (vlax-ename->vla-object pl) )
    (while (<= par (vlax-curve-getendparam pob))
    (setq pa (vlax-curve-getpointatparam pob par)
    ppl (append ppl (list pa))
    par (+ par 0.1)
    )
    )
    (setq ssl2 (acet-ss-to-list (ssget "cp" ppl )))
    (foreach x ssl1
    (if (not (member x ssl2))
      (entdel x)
    )
    )
    
    
    (setvar "osmode" oldos)
    (command "undo" "e")
    (Reinit)
    )
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;;CT chich toa do tren ban do
    ;;;
    (Defun Init()
    (setvar "BLIPMODE" 0)
    (setvar "CMDECHO" 0)
    (setvar "LUPREC" 0)
    (setq stl "standard")
    (setq k (getint "\n nhap ty le ban do: ") k1 (/ k 10) ) (setq scale k)
    (setq hi (* 0.002 scale))
    (setq wi 0.9)
    )
    (Defun Reinit()
    (setvar "BLIPMODE" 1)
    (setvar "CMDECHO" 1)
    (setvar "LUPREC" 4)
    (princ)
    )
    (Defun XY( pt / x y xx yy  ptx pty)
    
    
    (setq y (car pt))
    (setq x (cadr pt))
    (command "_Line"
             	(list (- y (* 0.0025 scale)) x 0.0)
             	(list (+ y (* 0.012 scale)) x 0.0) ""
    )
    (command "_Line"
             	(list y (- x (* 0.0025 scale)) 0.0)
             	(list y (+ x (* 0.0025 scale)) 0.0) ""
    )
    (setq xx (rtos x 2))
    (setq yy (rtos y 2))
    (setq pt y)
    (setq y x)
    (setq x pt)
    (setq ptx (list (+ x (* 0.001 scale)) (- y (* 0.0025 scale)) 0.0))
    (setq pty (list (+ x (* 0.0025 scale)) (+ y (* 0.001 scale)) 0.0))
    (Maketext ptx 0 xx)
    (Maketext pty 90 yy)
    
    )
    (Defun Maketext( diem ang string / etd)
    (setq edt (list (cons 0 "text")
      	(cons 8 "GhichuTD")
      	(cons 62 5)
      	(cons 10 diem)
      	(cons 1 string)
      	(cons 7 stl)
      	(cons 40 hi)
      	(cons 41 wi)
      	(cons 50 (/ (* ang PI) 180.0))
    )
    )
    (entmake edt)
    )
    
    

    • Vote tăng 1

  6. Cad 2004 thì LI vẫn là LWPOLYLINE! Không biết R14 thì LI sẽ ra cái gì? => thông tin này nguy hiểm quá!

     

    Ở cad R14 khi LI lên thì cũng là LWPOLYLINE. Về cad thì mình vẫn còn tối tăm lắm. chỉ cài và sử dụng chưa biết hiệu chỉnh nhiều. nên cứ cài mặc định.

    nên khi vẽ lệnh PL ở cad R14 và cad2007 li thì đều là LWPOLYLINE ( lấy được tọa độ các đỉnh của PL)

    Còn ở cad 2004 nó chỉ là POLYLINE.

     

    Tìm nửa ngày cuối cùng cũng được cái này. để đưa thằng PL ở cad2004 là LWPOLYLINE

    Search một hồi thì ra cái này PLINETYPE

    0 - POLYLINE

    1 - LWPOLYLINE

    • Vote tăng 1

  7. Nó chỉ là một lệnh ML sinh ra

     

    THICHO và THITCHO® vẫn là thịt cầy!

     

    Nếu nó là một vậy tại sao khi mình thực hiện một số LSP thì với LWPOLYLINE thì LSP thực hiện được còn với POLYLINE thì LSP lại không thực hiện được.?

    (Cùng là hạt lúa, khi bỏ vỏ thì nó là hạt gạo, khi nấu chín thì nó lại gọi là cơm. sao không gọi sát lúa mà là sát gạo, là luộc gạo mà là nấu cơm)


  8. bác nào chỉ giùm em cách cài express tool với. Em thấy có nhiều lệnh hay trong phần này nhưng mò mãi mà chưa cài được. Em đang sử dụng cad 2007. Rất mong các bác chỉ dùm.

     

    Này nhé cũng đơn giản thôi. Bạn vào Control Panel/Add and remove Program chọn vào nút Change của phần Cad , nó sẽ bắt đầu hỏi là bạn gỡ bỏ hoàn toàn or sửa lỗi or Add or remove Features thì bạn chọn Add or remove Features rồi kiểm chọn phần Express Tool là ok. Cad sẽ tự cài thêm phần Express Tool vào chương trình cho bạn! Chúc vui vẻ! mellow.gif


  9. Hề hề hề,

    Như mình đã nói từ trước là mình giữ nguyên cách nhập tọa độ của bạn mà không thay đổi gì. Sau đó bạn lại yêu cầu chỉ thay chiều cao text nên mới có cái sự này. Để làm như cũ thì rất đơn giản là bạn trả cái dòng code (setq hi (getreal "\n Nhap gia tri chieu cao text: ")) thành (setq hi (* 0.002 scale)) và thay dòng code (setq scale 500) bằng đoạn code .

    (setq k (getint "\n nhap ty le ban do: ") k1 (/ k 10) ) (setq scale k)

    Đồng thời xóa đoạn code (setq k (getint "\n nhap ty le ban do: ") k1 (/ k 10) ) trong hàm chính

    Chúc bạn vui.

     

     

    OK

    Lisp đã như ý muốn.

    Từ giờ tiết kiệm được nhiều time rùi.

     

    À Còn điều này nữa, hình như lisp này khi chọn đường bao mà trong đó có Arc nó không vẽ theo thì phải.

    giờ muốn chọn đường bao có cả Arc trong đó thì làm thế nào bạn nhỉ?

    Thanks


  10. Thanks!

    Sau khi sử dụng lisp mình gặp phải vấn đề sau:

    chạy lisp ở tỷ lệ 1/500 để chiều cao text là 1 thì không có vấn đề gì.

    nhưng khi ở tỷ lệ 1/1000 để chiều cao text là 2 cho đúng kích thước với tỷ lệ thì 2 đường line nó vẫn nhỏ như ở tỷ lệ 1/500. còn text tọa độ thì nó lớn hơn và bị đè lện nhau.

    c7c9a33c938fcbdfefbc11580790573f_43189525.t21.jpg

    Ở lsp cor cũ của mình mỗi khi sử dụng thì mình thay tỷ lệ ở dòng

    (setq scale 5000)

    VD: tỷ lệ 1/500 thay là 500 chiều cao chữ là 1

    1/1000 thay là 1000 chiều cao chữ là 2

    1/2000 thay là 2000 chiều cao chữ là 4

    khi thay tỷ lệ vào thì lsp tự động đổi chiều cao chữ và 2 line thay đổi phù hợp với text tọa độ.

     

    Bản chỉnh sửa giúp mình khi nhập chiều cao text thì 2 line sẽ tự động thay đổi cho phù hợp với text.

    Thanks!


  11. Không biết nói thế nào hơn: Thanks bạn nhìu nhìu nhìu>

    Bạn viết đúng theo ý của mình rùi đó:

    Sau khi test thử lsp của bạn mình muốn chính sửa như sau:

    +Có thể chọn luôn đường bao (pick chuột vào đường bào) chứ không pick từng đỉnh đường bao một

    +có thể thêm là hỏi chiều cao chữ được ko?

    + lisp hiện tại chỉ hiện đường line theo trục x không hiển thị đường line trục y. và có một số các điểm toạ độ gần đường bao không có đường line. bạn sửa lại là hiển thị đường line cả trục x và trục y như lsp cũ của mình được ko.

    + Lisp này hình như ko chạy được trên cad 2004 bạn có thể cho nó chạy trên các đời cad gium mình với.

×