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

leejang

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    117

  • Đã tham gia

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

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

  2. Đã đăng · Trả lời báo cáo

    Em đã xóa chữ not đi, nhưng xóa xong thì ko chạy luôn ạ.

    khi chạy thì nó báo lỗi như sau:

     

    Command: di DIST Specify first point: Specify second point:

    Distance = 1.60, Angle in XY Plane = 0d0'0", Angle from XY Plane = 0d0'0" ' đoạn này em đo khoảng cách text

    Delta X = 1.60, Delta Y = 0.00, Delta Z = 0.00

    Command: ntt

    Select objects: Specify opposite corner: 36 found

    Select objects:

    Khoang cach :1.6

    <=d hay =d ? [<] :

    ; error: bad function: T

     

    đây là code đã xóa đi

     

    (defun c:ntt(/ lstObj d ans ins! tObj tam isFound lstObj lstRs)

    (setq lstObj (mapcar 'vlax-ename->vla-object (acet-ss-to-list (ssget (list (cons 0 "*TEXT")))))

    d (getdist "\nKhoang cach :")

    ans (getstring "\n<=d hay =d ? [<] :")

    )

    (defun ins!(e)(vlax-get e 'Insertionpoint))

    (while (setq tObj (car lstObj))

    (setq tam (ins! tObj))

    (cond ((setq isFound (vl-member-if '(lambda(x)(and (setq kc (- (distance (ins! x) tam) d))(if (wcmatch ans ",<")((minusp kc))(zerop kc))))

    (setq lstObj (cdr lstObj))))

    (setq isFound (vl-sort isFound '(lambda(x y)(< (distance (ins! x) tam)(distance (ins! y) tam))))

    lstObj (vl-remove (car isFound) lstObj)

    lstRs (vl-sort (list tobj (car isFound)) '(lambda(x y)(< (car (ins! x))(car (ins! y))))))

    (vla-put-textstring (car lstRs)

    (strcat

    (vla-get-textstring (car lstRs)) "."

    (vla-get-textstring (last lstRs))

    )

    )

    (vla-delete (last lstRs))

    )

    )

    )

    )

     

     

     

     

    Còn đây là phương án cho chữ d ra đằng trước, khi chạy thì nó chạy bình thường nhưng khoảng cách điểm chèn text là 1.57 đo = di nhưng nhập vào 0.1 vẫn chạy ok.

    Delta X = 1.57, Delta Y = -0.30, Delta Z = 0.00

    Command: ntt

    Select objects: Specify opposite corner: 4 found

    Select objects:

    Khoang cach :0.1

    <=d hay =d ? [<] :<

    nil

     

    code

     

    ;;;=========== noi text

    (defun c:ntt(/ lstObj d ans ins! tObj tam isFound lstObj lstRs)

    (setq lstObj (mapcar 'vlax-ename->vla-object (acet-ss-to-list (ssget (list (cons 0 "*TEXT")))))

    d (getdist "\nKhoang cach :")

    ans (getstring "\n<=d hay =d ? [<] :")

    )

    (defun ins!(e)(vlax-get e 'Insertionpoint))

    (while (setq tObj (car lstObj))

    (setq tam (ins! tObj))

    (cond ((setq isFound (vl-member-if '(lambda(x)(and (setq kc (- (distance (ins! x) tam) d))(if (wcmatch ans ",<")(not (minusp kc))(zerop kc))))

    (setq lstObj (cdr lstObj))))

    (setq isFound (vl-sort isFound '(lambda(x y)(< d (distance (ins! x) tam)(distance (ins! y) tam))))

    lstObj (vl-remove (car isFound) lstObj)

    lstRs (vl-sort (list tobj (car isFound)) '(lambda(x y)(< (car (ins! x))(car (ins! y))))))

    (vla-put-textstring (car lstRs)

    (strcat

    (vla-get-textstring (car lstRs)) "."

    (vla-get-textstring (last lstRs))

    )

    )

    (vla-delete (last lstRs))

    )

    )

    )

    )

  3. Đã đăng · Trả lời báo cáo

    Cảm ơn anh Ketxu, lisp chạy tốt lắm. Nhưng anh cho em hỏi thêm là cái khoảng cách giữa 2 text đó nó tính bằng đơn vị như thế nào vậy ? bởi vì em đo bằng Di thì khoảng cách insert point = 1.6 nhưng mình nhập giá trị 0.000001 và và chọn < mà nó vẫn nối được ? Còn ở trên em nói là tính khoảng cách theo phương X với mục đích để tránh nó lấy nhầm vợ thằng khác đó ạ. bởi vì các text bị vỡ có đặc điểm là nó có cùng tọa độ y nên mình mới có thể lấy khoảng cách theo X.

    Còn trường hợp kiểm tra text là số thì em hoàn toàn có thể tự làm được ạ.

    cảm ơn các anh trên diễn đàn ạ, em có gì không phải thì các anh bỏ qua nhé !

  4. Đã đăng · Trả lời báo cáo

    hic. Anh hết hứng thì em cũng xin chịu rồi. Nhưng em đã nói ở trên là khoảng cách D do người dùng nhập vào rồi mà. Anh không đọc kỹ thôi. Còn để tổng quát bài toán để có thể áp dụng trong trường hợp khác được thì làm sao để với những text có mã DXF khác nhau nó nối được thì mọi người mới dùng được ạ ?

  5. Đã đăng · Trả lời báo cáo

    Lúc trước em đã thử rồi mới nói chứ ạ, nhưng lisp không nối được do xung với lisp của em mà em không biết.Đúng là lisp có nối được. nhưng mà lisp chạy ko ổn định lúc chạy lúc không ? Do cách quét đối tượng sao ý ? quét ít text thì thường ko nối được. Em thấy cách quét đối tượng ở đây có ảnh hưởng đến việc chạy lisp ? không biết anh Nguyenthanhbinh có lời khuyên nào về cách quét đối tượng không ạ ?

    Khi đổi 2 text đều có justify là left thì lisp không nối được mặc dù các text xích lại gần nhau hơn ???

    Và khi một số cặp text có khoảng cách xa nhau cũng không nối được ? => chưa đúng đề bài đặt ra là nối text cách nhau <d ( trường hợp tổng quát nhất ) ?

  7. Đã đăng · Trả lời báo cáo

    Lisp nối Text? Riêng tôi đã có tới 4 lisp nối text trên Cadviet. Bạn vào các link dưới đây xem link nào phù hợp thì dùng, hoặc link nào gần phù hợp thì y/c sửa. Tôi sẽ sửa cho (để tránh loãng 4rum).

    http://www.cadviet.c...80

    http://www.cadviet.c...60

    http://www.cadviet.c...=0

    http://www.cadviet.c...40

    Em đã thử tất cả các lisp nối text của anh và anh Ketxu viết nhưng mà không nối được đúng trong bài toán này. Có cái lisp "Ha" của anh là dạng gần giống bài toán này nhất, nhưng mà nó không nối được. Cái file text cần nối http://www.mediafire...0be6iraymbmdzzo

    Em nghiên cứu cái file text cần nối đó thì thấy rằng mình nối tự động bằng cách nối các text cách nhau 1 đoạn <d (lựa chọn 1) hoặc nối các text cách nhau =d ( lựa chọn 2) theo phương X thì sẽ cho kết quả chuẩn nhất.

  8. Đã đăng · Trả lời báo cáo

    Khoảng cách d đó do người dùng nhập vào " tính theo phương X, không tính là khoảng cách theo mọi phương để tránh nối nhầm", để tổng quát bài toán và mọi người sử dụng được thì ta sẽ phân làm 2 trường hợp lựa chọn, Lựa chọn 1: lisp sẽ nối 2 text có khoảng cách <d lại với nhau, Lựa chọn 2: lisp chỉ nối các text cánh nhau 1 đoạn đúng bằng d. cái khoảng cách d em đo sử dụng bắt điểm insert, nó là giá trị cố định. ( với cái file text em gửi thì phải chuyển toàn bộ Justify của text về left )

     

    command: nt

    khoang cach noi d=:

    Nối text cách nhau = d bấm 1; nối text cách nhau <d bấm 2

    select object:

  9. Đã đăng · Trả lời báo cáo

    - xin lỗi anh KETXU, vì hôm trước em viết yêu cầu bị đưa vào thùng rác nên em nghĩ đã diễn đạt đủ. hic. Em xin update lại như sau:

    - text quét chọn all

    - khoảng cách text d tính từ tâm text tới text hay từ viền đến viền hay từ Insertion Point đến InsertioPoint hay từ AlignmentPoint đến ALignment Point em nghĩ nó giống nhau ? Cái này em cũng không hiểu lắm. Xin gửi file lên để các anh ngâm cứu.

    - text 1 =15 có x nhỏ sẽ là phần bên trái dấu phẩy , text 2=25 có X lớn sẽ là phần thập phân sau khi nối , text nối xong ghi đè vào text 1 và text 2 bị xóa đi.

    đây là file Text : http://www.mediafire...0be6iraymbmdzzo

     

    15 25 sẽ nối thành 15.25 và ghi đè vào 15, xóa 25 đi

  11. Đã đăng · Trả lời báo cáo

    Em đang cần cái lisp nối text với các yêu cầu cụ thể như sau:

    giả sử text 1 =15, text 2=25 và bây giờ cần nối 2 text này lại thành 15,25

    tức là sẽ thêm dấu phẩy đằng sau text 1. Lisp sẽ tự động nối các text lại với nhau nếu khoảng cách giữa 2 text = giá trị ta nhập vào.

    text có tọa độ X nhỏ hơn sẽ là text 1, và text có tọa độ x lớn sẽ là text 2 ( phần sau dấu phẩy )

    command: nt

    khoang cach noi d=:

    select object:

    Kết quả là lisp sẽ so sánh các text nào cách nhau 1 đoạn = d thì sẽ nối lại. Text có x nhỏ sẽ là text 1,

    Lisp này sử dụng cho các bình đồ bị explode bằng autocad, các text cao độ bị vỡ. Mong các anh trên diễn đàn giúp đỡ. Xin đừng xóa bài của em. Nếu xóa xin cho em biết lý do ?

  12. Đã đăng · Trả lời báo cáo

    Viewport Toggle chế độ DisplayLocked :

     

    (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. ")
 )
 ((or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
  (alert " Lisp can only be done in paper space. ")
 )
 ((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)
)

    P/s : sử dụng ActiveSS nhanh thật :)

    hì. Em không biết cái lệnh mview kia vì e ko dùng lệnh đó bao h. Biết lệnh đó rùi thì e tự viết đc.

    Gửi các bác, hic. làm j mà các bác mắng e ghê quá.

    (defun C:lk() ; khóa khung layout

    (SETQ SS (SSGET))

    (command "mview" "L" "ON" SS "")

    )

     

    (defun C:ULK(); mở khóa khung layout

    (SETQ SS (SSGET))

    (command "mview" "L" "OFF" SS "")

    )

  14. Đã đăng · Trả lời báo cáo

    Cám ơn 'phamthanhbinh' rất nhiều. Lisp đã giải quyết tương đối tốt các vấn đề. Trước khi nhập khoảng cách mình cũng đã đo khoảng cách từ mũi tên đến text.

    Với bản vẽ lớn hay nhỏ thì khoảng cách này luôn không đổi ? (Mình chạy từ Nova ra mà)

    Có lẽ, lỗi ở đây chính là như "ketxu" nói: Hàm ssget nó phụ thuộc vào khung nhìn ?

    Vì mình thử: với khung nhìn lớn thì lisp oke; nếu khung nhìn nhỏ thì lisp sẽ xóa tất cả mũi tên ?

    Nếu giải quyết được vấn đề này thì code lisp hoàn chỉnh hơn>

    Cám ơn bạn rất nhiều và các anh em code góp ý. Nó giúp mình rất nhiều trong công việc.\

    Thân !

    Có vấn đề thế này ạ. Khi có 2 mũi tên và 2 giá trị cạnh sát nhau. Nó xoá mất 1 giá trị mình định trước và xoá luôn cả 2 mũi tên. Bi h làm sao để khống chế cho lisp chỉ xoá 1 mũi tên+1giá trị thôi ạ ? Bởi vì chạy nova thì mũi tên và giá trị thường theo cặp. Em upload file lên, ở đây ta chỉ xoá giá trị 57.69% và cái mũi tên đi kèm của nó.

    Đây là file ạ : http://www.cadviet.com/upfiles/3/nova_tc1tc2.dwg

  15. Đã đăng · Trả lời báo cáo

    Hề hề hề,

    Không phải đâu là không phải đâu.

    Sở dĩ cái mũi tên dưới số 4% của bạn bị mất là do bạn nhập cái khoảng cách từ text tới arrow quá lớn đấy thôi. Do vậy khi lấy vùng chọn nó ôm cả cái mũi tên ấy vào và xóa béng đi một lượt bạn ạ. Mình đã test thử bản vẽ bạn gửi với khoảng cách nhập vào là 0.3 thì nó chả bị sao hết, xóa ngon như bạn muốn.

    Để tránh trường hợp này bạn có thể thay vì nhập khoảng cách, bạn cho chọn một text chuẩn và lấy chiều cao text làm cái khoảng cách ấy sẽ tốt hơn bạn ạ.

    Hoặc là bạn chuyển hệ tọa độ về World trước khi chọn đối tượng như bài trước mình đã post.

    Chúc bạn vui.

    Hề hề. Lisp này quả thật rất ứng dụng cho dân thiết kế đường. Thanks các bác rất nhiều nhé ! kekeke. h thì đỡ phải xoá thủ công mất time rùi.

  17. Đã đăng · Trả lời báo cáo

    Bạn dùng thử cái này

    (defun c:o2p()
 (setq ob (vlax-ename->vla-object(car(entsel"\n chon doi tuong de offset: ")))
kc (* (getreal"\n Nhap khoang cach offset: ") 2)
sp (vlax-safearray->list(vlax-variant-value(vla-get-startpoint ob)))
ep (vlax-safearray->list(vlax-variant-value(vla-get-endpoint ob))))
 (command "Mline" "j" "z" "s" kc sp ep "")
 (command "explode" "l" "")
 )

    Em thì chỉ dùng trong khi vẽ thép. Vậy bác chỉnh giúp em để đối tượng mới sinh ra thuộc layer "THEP", và đối tượng có màu 4 được ko ạ ?

  18. Đã đăng · Trả lời báo cáo

    Cop đoạn lisp này vào, mỗi lần mở file load lisp này thì sẻ xóa hết những con virus acad.lsp củ chuối đó

    ***************

    (defun cleanvirus( / lspfiles lspfile x)

    (setq lspfiles '("acad.mnl" "acadappp.lsp" "acad.lsp" ))

    (foreach lspfile lspfiles

    (while (setq x (findfile lspfile))

    (progn

    (vl-file-delete x)

    (princ "\nDeleted file ")

    (princ x)

    );progn

    );while

    );foreach

    )

    (cleanvirus)

    ***************

    Bạn dùng chương trình diệt virut NOD32, Tải tại trang Nod32.com. Chương trình này diệt virut CAD rất tốt. không cần crack hay đăng ký. Nhẹ hơn bản KIS mà diệt virut hiệu quả !

  20. Đã đăng · Trả lời báo cáo

    Thực tế khi ta vẽ thì nhiều khi phải blog đối tượng lại để scale lên để mọi đối tượng đều tăng kích thước giống nhau. Khi ta "X" ra thì các đối tựơng Dim sẽ bị về đúng kích thước theo kiểu của Dim style đó. Vậy bi h có cách nào để khi ta "X" ra thì mọi đối tượng DIM giữ nguyên size trước khi "X" mà không bị nhảy về kiểu DIMSTYLE cũ của nó ạ ?

  22. Đã đăng · Trả lời báo cáo

    In kiểu này thì cũng được. Nhưng bình đồ sẽ bị ngược theo 1 chiều. Tuy rằng tiết kiệm giấy mực nhưng bình đồ nhìn rất chuối. Các địa vật sẽ bị nghiêng đảo. Khung bản đồ bạn đưa ra có nhiều kiểu, như vậy in theo kiểu gì? khổ giấy gì? Mình cũng cố gắng xem liệu được không vì trình độ nông cạn.

    Người ta làm như thế và đưa cho mình in. Nhiệm vụ là chỉ có in ra theo các khung đó thôi. Còn xấu thì kệ người ta. Vì từ trước tới h người ta làm như thế quen rồi. mặc kệ thui . hic

  24. Đã đăng · Trả lời báo cáo

    Em gặp một số bản vẽ mà người ta lồng khung không bình thường, cụ thể như sau: giả sử khung in hình chữ nhật ABCD, thì thường là cạnh AB song song với trục X nằm ngang. Thì ta in bình thường, nhưng gặp bản vẽ mà cạnh AB của hình chữ nhật nghiêng 1 góc là G so với trục X thì làm sao để in được bản vẽ theo Window ABCD ? xin được chỉ giáo !

  25. Đã đăng · Trả lời báo cáo

    Chú ý, chú ý : Lisp chạy được khi cài phụ trợ Express.

    Bạn tski259 chưa cài Express nên chưa sử dụng được Lisp :rolleyes:

    Do vậy, Tue_NV viết lại, không sử dụng hàm ACET-GEOM-SS-EXTENTS-FAST. Các bạn chạy thử xem.

    Với phép * /, xuất text sẽ viết sau nhé

    (defun c:cs(/ ss lis stp oldlu ctnc ctnch shang ResC ResR matran i j k ptui dem)
;Copy right by Tue_NV
(defun dd(e1 e2 / tb1 tb2)
   (setq tb1 (textbox e1) tb2 (textbox e2))
   (max (abs (- (caadr tb1) (caar tb1))) 
 (abs (- (caadr tb2) (caar tb2))) 
   )
)
(defun layminmax( / minpp maxpp LX LY)
  (vlax-for x (vla-get-activeselectionset (vla-get-activedocument(vlax-get-acad-object)))
(vla-getboundingbox x 'minpp 'maxpp)
(setq LX (append LX (list (car(safearray-value minpp)))
		    (list (car(safearray-value maxpp)))))
(setq LY (append LY (list (cadr(safearray-value minpp)))
		    (list (cadr(safearray-value maxpp)))))
  )
  (setq minp (list (apply 'min LX) (apply 'min LY) 0.0))
  (setq maxp (list (apply 'max LX) (apply 'max LY) 0.0))	
)
(defun arrangess(ss / lst)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (vl-sort lst '(lambda (x y) 
     (if (equal (cadr (assoc 10 (entget x)))
                (cadr (assoc 10 (entget y)))
                (dd (entget x) (entget y))   )
           (> (caddr (assoc 10 (entget x)))
              (caddr (assoc 10 (entget y)))
           )
       (< (cadr (assoc 10 (entget x)))
              (cadr (assoc 10 (entget y)))
           )        
            )
       ))
)
 lst) 
(defun ktrass(ss / i ent ret)
(setq i 0 L (sslength ss))
(while (< i L)
    (if (distof (cdr(assoc 1 (entget (ssname ss i)))))
 (setq i (1+ i) ret t)
 (progn (setq i L ret nil) (alert "Tap ss co chua chu - Khong thuc hien duoc phep tinh"))
    )
 )
ret
)
(vl-load-com)
(setvar "DIMZIN" 0)
(prompt"\nChon ma tran")  
(if (ktrass (setq ss (ssget '((0 . "TEXT")))))
(progn
(layminmax)

(or *stp* (setq *stp* 2))
(setq stp (getint (strcat "\n So chu so thap phan <" (itoa *stp*) "> :")))
(if stp (setq *stp* stp) (setq stp *stp*))
(setq oldlu (getvar "luprec"))
(setvar "luprec" stp)
(setq lis (arrangess ss))

(setq ctnc (cond (ctnc) ("+")))  
(initget "+ -")
(setq ctnc (cond ((getkword (strcat "\nChon phep tinh: [+ -] <" ctnc ">"))) (ctnc)))
(cond ((= ctnc "+") (setq ctnch + shang 0.0))
     ((= ctnc "-") (setq ctnch - shang 0.0))
)

;(setq lis (reverse lis) )  
(setq ResR '() ResC '() ptui 0.0 i 1 j 0 k 0 Matran '() )
(while (< j (length lis))
  (if (not (equal (cdr(assoc 10 (entget (nth j lis)))) minp  (cdr(assoc 40 (entget (nth j lis))))  ))
(setq i (1+ i) j (1+ j))
(setq j (length lis))
  )
)
(setq j (/ j i))

(Repeat j
   (Repeat i
(setq ptui (ctnch ptui shang (atof (cdr (assoc 1 (entget (nth k lis)))))) 
	matran (append matran (list (atof (cdr (assoc 1 (entget (nth k lis)))))))
	k (1+ k))
  )
  (setq ResC (append ResC (list ptui)) ptui 0.0)
)
(setq k 0 dem 0)
(Repeat i
  (Repeat j
(setq ptui (ctnch ptui shang (nth k matran)))
(setq k (+ k i))
  )
(setq ResR (append ResR (list ptui)) ptui 0.0)
(setq dem (1+ dem))
(setq k dem)
)
))
(Alert (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
(princ (strcat "\nKet qua hang : " (vl-princ-to-string ResR)
        "\n\nKet qua Cot  : " (vl-princ-to-string ResC)
)
)
)

     

    Em chạy thử trên CAD 2012 thì chạy ok. Nhưng đúng là nó chưa ghi kết quả được. Chủ để này hay, khi nào có time bác TUỆ hoàn thiện nốt cho anh em thì tốt quá !

×