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

thanhduan2407

Nhà quảng cáo
  • Số lượng nội dung

    1.137
  • Đã tham gia

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

  • Ngày trúng

    23

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


  1. Mình Test rất OK trên bản vẽ bạn gửi. Còn bạn thao tác thế nào là do bạn. Mình giúp ko mất phí chỉ đến thế. Gửi phí 2 triệu mình giúp đến cuối. Ko thì Cancel. Ko ai miễn phí đâu. Mình viết bằng tâm. Nhưng vì bạn non quá. Mất tgian thêm thì mất phí. "Mọi sự ngu dốt đều trả giá bằng tiền mặt" như lời thầy giáo mình bảo.


  2. Bạn thử xem thế nào nhé!

    (defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
      (vl-load-com)
      (defun *error* (msg)
        (if	Olmode
          (setvar 'osmode Olmode)
        )
        (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
          (princ (strcat "\nError: " msg))
        )
        (redraw)
        (princ)
      )
      (command "undo" "begin")
      (setq Olmode (getvar "OSMODE"))
      (setvar "OSMODE" 0)
      (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
      (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
        (progn
          (setq ssDim (ssget '((0 . "DIMENSION"))))
          (if ssDim
    	(progn
    	  (setq LtsDim (acet-ss-to-list ssDim))
    	  (if (member Obj1 LtsDim)
    	    (setq LtsDim (vl-remove Obj1 LtsDim))
    	  )
    	  (if LtsDim
    	    (progn
    	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
    	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
    	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
    	      (setq ObjXline (entlast))
    	      (setq ssChon (ssadd))
    	      (foreach eDim LtsDim
    		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
    		(setq PntG2 (cdr (assoc 11 (entget eDim))))
    		(setq KC (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2 T)))
    		(if (and (not (equal KC 0.0 1e-1))
    			 (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)(equal G2 (- G1 pi) 1e-8))
    		    )
    		  (ssadd eDim ssChon)
    		)
    	      )
    	      (entdel ObjXline)
    	    )
    	  )
    	)
          )
        )
      )
      (if (> (sslength ssChon) 0)
        (progn
          (Alert (strcat "C\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn"))
          (Prompt (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n"))
          (sssetfirst nil ssChon)
        )
        (progn
          (Alert "Kh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn")
          (Prompt "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n")
        )
      )
      (setvar "OSMODE" Olmode)
      (princ)
    )

     


  3. 18 phút trước, DungNguyen685 đã nói:

    tính cả trường hợp các phương còn lại

    z2398839698479_46692264aeb98132ab41314c6808d44a.jpg.9caefd9240dd662ab74c129f32727a0e.jpg

    Bạn thử xem!

    (defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
      (vl-load-com)
      (defun *error* (msg)
        (if	Olmode
          (setvar 'osmode Olmode)
        )
        (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
          (princ (strcat "\nError: " msg))
        )
        (redraw)
        (princ)
      )
      (command "undo" "begin")
      (setq Olmode (getvar "OSMODE"))
      (setvar "OSMODE" 0)
      (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
      (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
        (progn
          (setq ssDim (ssget '((0 . "DIMENSION"))))
          (if ssDim
    	(progn
    	  (setq LtsDim (acet-ss-to-list ssDim))
    	  (if (member Obj1 LtsDim)
    	    (vl-remove Obj1 LtsDim)
    	  )
    	  (if LtsDim
    	    (progn
    	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
    	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
    	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
    	      (setq ObjXline (entlast))
    	      (setq ssChon (ssadd))
    	      (foreach eDim LtsDim
    		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
    		(setq PntG2 (cdr (assoc 11 (entget eDim))))
    		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
    		(if (and (not (equal Kc 0.0 1e-8))  (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
    		  (ssadd eDim ssChon)
    		)
    	      )
    	      (entdel ObjXline)
    	    )
    	  )
    	)
          )
        )
      )
      (if ssChon
        (sssetfirst nil ssChon)
      )
      (setvar "OSMODE" Olmode)
      (princ)
    )

     


  4. Không biết như này phù hợp với bạn chưa?

    (defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
      (vl-load-com)
      (defun *error* (msg)
        (if	Olmode
          (setvar 'osmode Olmode)
        )
        (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
          (princ (strcat "\nError: " msg))
        )
        (redraw)
        (princ)
      )
      (command "undo" "begin")
      (setq Olmode (getvar "OSMODE"))
      (setvar "OSMODE" 0)
      (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
      (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
        (progn
          (setq ssDim (ssget '((0 . "DIMENSION"))))
          (if ssDim
    	(progn
    	  (setq LtsDim (acet-ss-to-list ssDim))
    	  (if (member Obj1 LtsDim)
    	    (vl-remove Obj1 LtsDim)
    	  )
    	  (if LtsDim
    	    (progn
    	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
    	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
    	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
    	      (setq ObjXline (entlast))
    	      (setq ssChon (ssadd))
    	      (foreach eDim LtsDim
    		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
    		(setq PntG2 (cdr (assoc 11 (entget eDim))))
    		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
    		(if (and (equal Kc 0.0 1e-8) (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
    		  (ssadd eDim ssChon)
    		)
    	      )
    	      (entdel ObjXline)
    	    )
    	  )
    	)
          )
        )
      )
      (if ssChon
        (sssetfirst nil ssChon)
      )
      (setvar "OSMODE" Olmode)
      (princ)
    )

     


  5. 1 giờ} trướ}c, Luongquocsonxd đã nói:

    ;; Thường thi khi chọn đối tượng thì đối tượng đó hiển thị những đường nét đứt (giống như nét Hidden)

    ;; Mình gửi đoạn lisp nội dung là thay thế Text ứng với một Text trước đó có sẵn

    ;; Sau khi mình nhập lệnh và chọn text "nguồn" thì Text nguồn đó không hiển thị dạng nét đứt để mô tả là đối tượng Text nguồn đã được chọn mà nó vẫn bình thường

    ;; Nhiều khi lick chọn đối tượng Text nguồn nhưng không biết là đã chọn được nó chưa

    ;; nhờ anh em giúp làm sao khi chọn Text nguồn thì nó hiển thị dạng nét đứt để dễ nhận biết là nó đã được chọn.

    ;; Thank you anh em!

    (defun C:TC1 (/ con rep ch_text so_text text_val text_run)
      (setvar "Cmdecho" 0)
      (setq so_text NIL
        text_val NIL
        ch_text NIL
            so_text(entsel "\nChon Text goc <Noi dung mau>: "))
      (if so_text 
          (progn
        (setq so_text(entget(car so_text)))
        (if(or(= (cdr(assoc 0 so_text)) "TEXT");Kiem tra du lieu Text
              (= (cdr(assoc 0 so_text)) "MTEXT") )
           (setq text_val(cdr(assoc 1 so_text)) )
        );if
        (if(> (strlen text_val) 0)
           (progn
                 (prompt "\nChon Texts muon sua noi dung theo Text goc: ")
             (setq ch_text(ssget '((0 . "*TEXT"))) )
           )
           (princ "\nKhong chon duoc Texts can sua !")
        );if
        (if(and ch_text text_val)
           (progn
             (setq rep (sslength ch_text)
               con 0)
             (while (> rep con)
               (setq text_run(entget(ssname ch_text con))
                 ch_val(assoc 1 text_run))
               (setq text_run(subst (cons 1 text_val) ch_val text_run))
               (entmod text_run)
               (princ ".")
               (setq con(+ con 1))
             );while
             (princ "\n")(princ rep)(princ " Texts da duoc thay doi !")
            );progn
         );if
           );progn
        );if
      (princ)
    ); 

    Code cho bạn xíu!

    (defun C:TC1 (/ COLOR NDUNG SSTEXT TEXTN X)
      (setvar "Cmdecho" 0)
      (setq TextN (car (entsel "\nCh\U+1ECDn Text ngu\U+1ED3n: ")))
      (if (and TextN
    	   (or (= (cdr (assoc 0 (entget TextN))) "TEXT")
    	       (= (cdr (assoc 0 (entget TextN))) "MTEXT")
    	   )
          )
        (progn
          (setq Color (vla-get-color (vlax-ename->vla-object TextN)))
          (setq NDung (cdr (assoc 1 (entget TextN))))
          (vla-put-color (vlax-ename->vla-object TextN) 1)
          (prompt
    	"\nQu\U+00E9t ch\U+1ECDn Text c\U+1EA7n thay \U+0111\U+1ED5i n\U+1ED9i dung gi\U+1ED1ng Text ngu\U+1ED3n: "
          )
          (setq ssText (ssget '((0 . "*TEXT"))))
          (if ssText
    	(progn
    	  (mapcar '(lambda (x) (entmod (subst (cons 1 NDung) (assoc 1 (entget x)) (entget x))))
    		  (acet-ss-to-list ssText)
    	  )
    	  (vla-put-color (vlax-ename->vla-object TextN) Color)
    	  (Prompt
    	    "\nN\U+1ED9i dung \U+0111\U+00E3 \U+0111\U+01B0\U+1EE3c thay \U+0111\U+1ED5i  "
    	  )
    	)
          )
        )
        (progn
          (Prompt
    	"\nB\U+1EA1n ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng kh\U+00F4ng ph\U+1EA3i Text!"
          )
          (Alert
    	"B\U+1EA1n ch\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng kh\U+00F4ng ph\U+1EA3i Text!"
          )
        )
      )
      (princ)
    )

     


  6. Vào lúc 11/2/2021 tại 18:30, ketxu đã nói:

    Tết nhất share lại bài trên diễn đàn anh em ném gạch cho vui
     

    ️  Bạn tự tin vào trình CAD của mình ? Cùng Ketxu đánh giá lại một chút nhé

    ️ Nhiều bạn không biết khi học CAD thì chúng ta học những gì ? Con đường ra sao ? Nếu tự học thì học những gì ?

    ️ Nhiều bạn hỏi mình Em vẽ CAD 1,2 năm rồi, muốn học CAD nâng cao ? Nhưng bạn đã có thể học được Nâng cao hay chưa thì chưa biết ? Bạn đang nằm ở đâu trong thang bậc những người vẽ CAD

    Cũng có bạn hỏi lúc học Cơ bản thì học được gì ? Học nâng cao  là học gì ???

    ️ Vậy nên mình public phần chia sẻ 1 phần nội dung trong buổi Khai giảng lớp học này để các bạn tự trả lời các câu hỏi trên, tự tìm ra lộ trình hoặc tự đánh giá lại bản thân

    ️ Video chứa các mức đánh giá theo quan điểm cá nhân, có thể thay đổi theo thời gian và thực tế và có thể không hoàn toàn chính xác

    Video có chứa các từ ngữ nhạy cảm vì khi dạy mình hay nói tục, các bạn dưới 16+ cân nhắc

    Video chứa những lời mỉa mai các nhân vật hư cấu, anh em đừng chột dạ. Just funny ^^

    Video chứa mặt lấc cấc nhưng mình quay bằng OBS nên trót để, k biết bỏ phần CAM đi ntn nên mình che đi một phần cho đỡ phản cảm
     


    ️  XEM XONG CÁC BẠN ĐÁNH GIÁ LẠI MÌNH Ở MỨC NÀO, ĐỂ LẠI CMT CHO MÌNH BIẾT NHÉ ^^

    Tâm huyết và chịu khó quá. Chúc em năm mới gặt hái nhiều thành công, cống hiến cho diễn đàn ngày càng phát triển mạnh và bền vững. 
    Chúc bác @Doan Van Ha sức khoẻ dồi dào và chúc toàn thể anh em gặp nhiều may mắn, thành công và hạnh phúc.

    • Like 2

  7. 12 giờ trước, DuongTrungHuy đã nói:

    Chào Bạn!

     

    Tỉnh Vĩnh Long có kinh tuyến trục 105độ30ph nên theo toạ độ bản Cad chữ "Ấp Hoà Thuận" có toạ độ X=536478.3904  Y=1121686.5419 sẽ tương ứng với N10.14398  E105.83289 bấm ra đúng chữ đó ở Vĩnh Long (điểm đỏ)

     

    Vì vậy khẳng định nó ở VN2000 đó Bạn.

     

    Thân chào!

    Untitled11112.png

    Bạn đã mở bản vẽ "KhongBietToaDo.dwg" chưa nhỉ? Còn bản VN2000 kia thì cho nó lên google earth thì đúng vị trí rồi.


  8. (defun C:00 (/ I LTSDONG LTSTEXT SSTEXT TDO)
    ;;;;;;;XUAT TOA DO TEXT
      (vl-load-com)
      (setvar "CMDECHO" 0)
      (setq ssText (ssget (list (cons 0 "TEXT"))))
      (if ssText
        (progn
          (setq LtsText (acet-ss-to-list ssText))
          (setq LtsDong nil)
          (setq i 1)
          (foreach eT LtsText
    	(setq Tdo (TD:Text-Base eT))
    	(setq LtsDong (append LtsDong
    			      (list (list (rtos i 2 0)
    					  (rtos (cadr Tdo) 2 3)
    					  (rtos (car Tdo) 2 3)
    					  (rtos (caddr Tdo) 2 3)
    				    )
    			      )
    		      )
    	)
    	(setq i (1+ i))
          )
          (if (> (length LtsDong) 0)
    	(progn
    	  (if (vlax-get-or-create-object "Excel.Application")
    	    (WriteToExcel LtsDong)
    	    (WriteToCSV LtsDong)
    	  )
    	)
          )
        )
      )
      (princ)
    )
    (defun TD:Text-Base (ent / MA71 MA72 X11 Ma10 Ma11)
      (setq Ma10 (cdr (assoc 10 (entget ent))))
      (setq Ma11 (cdr (assoc 11 (entget ent))))
      (setq X11 (car Ma11))
      (setq Ma71 (cdr (assoc 71 (entget ent))))
      (setq Ma72 (cdr (assoc 72 (entget ent))))
      (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
    	  (and (= Ma71 0) (= Ma72 3))
    	  (and (= Ma71 0) (= Ma72 5))
          )
        Ma10
        Ma11
      )
    )
    (defun WriteToExcel (lst_data / col row x xlApp xlCells)
      (setq	xlApp	(vlax-get-or-create-object "Excel.Application")
    	xlCells	(vlax-get-property
    		  (vlax-get-property
    		    (vlax-get-property
    		      (vlax-invoke-method
    			(vlax-get-property xlApp "Workbooks")
    			"Add"
    		      )
    		      "Sheets"
    		    )
    		    "Item"
    		    1
    		  )
    		  "Cells"
    		)
      )
      (setq row 1)
      (foreach pt lst_data
        (setq col 1)
        (foreach coor pt
          (vlax-put-property xlCells 'Item row col coor)
          (setq col (1+ col))
        )
        (setq row (1+ row))
      )
      (vla-put-visible xlApp :vlax-true)
      (mapcar
        (function (lambda (x)
    		(vl-catch-all-apply
    		  (function (lambda ()
    			      (if x
    				(vlax-release-object x)
    			      )
    			    )
    		  )
    		)
    	      )
        )
        (list xlCells xlApp)
      )
      (gc)
      (gc)
    )
    
    (defun WriteToCSV (lst_data / fl)
      (if (setq fl (getfiled "Output File" "" "csv" 1))
        (if	(setq fl (open fl "w"))
          (progn
    	(foreach pt lst_data
    	  (write-line
    	    (LM:lst->str pt ",")
    	    fl
    	  )
    	)
    	(close fl)
          )
        )
      )
    )

     


  9. Mình dùng 1 số công cụ sau để phục vụ tạo ntd và vẽ TD TN
    Video cách đây 1 năm

    1 Nội suy cao độ từ 2 điểm

    2 Nội suy cao độ từ 2 điểm theo khoảng cách

    3 Nội suy cao độ từ 2 điểm theo số lượng

    4 Tạo Text cao độ là giao MCN với các đối tượng dạng đường 2D, 3D

    5 Đổi Polyline 2D thành 3D từ Text cao độ gán tại đỉnh

    6 Đổi Polyline 3D thành 2D

    7 Gán cao độ cho Point từ Text

    8 Gán cao độ cho Text từ Text

    9 Gán thông tin tuyến Text biên từ Text cọc trên tuyến

    10 Tạo và chèn Block khung cho Trắc Ngang ở Layout theo hàng cột

    11 In Trắc ngang hàng loạt bên Layout

    12 Chọn các Text gần Line theo khoảng nhập và chuyển sang Layer khác

    13 Lấy Text cọc ở biên để tạo Text cọc ở tim tuyến

    14 Nội suy cao độ tim đường

    15 Chọn các Line, các Text nằm trong khoảng nhập sẽ bị di chuyển vuông góc với từng Line

    16 Di chuyển Text được chọn vuông góc với Line, Pline không phụ thuộc khoảng cách

    17 Chọn Line hoặc Pline sau đó chọn các Text di chuyển vuông góc với Line, Pline theo khoảng nhập

    18 Nội suy cao độ đỉnh Pline từ Pline 3D cơ sở

    19 Phát sinh cọc trên tuyến theo khoảng cách hoặc chỉ điểm hoặc theo Text có sẵn trên tuyến hoặc chỉ điểm giữa 2 điểm (CD2D)

    20 Đặt tên cọc trên tuyến

    21 Lưu vị trí đang View lần 1

    22 Lưu vị trí đang View lần 2

    23 Mở vị trí View lần 1

    24 Mở vị trí View lần 2

    25 Sắp xếp lại Trắc Ngang theo nhóm và số hàng cột trong nhóm

    26 Tạo Text là mã địa vật từ Text

    27 Tạo bảng ghi thông số đoạn cong A, R, T, P, K, H

    28 Kiểm tra Text có đứng 1 mình không

    29 Tìm Text độc lập

    30 Di chuyển Text về Point

    31 Di chuyển Text về Text

    32 Di chuyển Text về Block

    33 Di chuyển Text về tâm vùng

    34 Di chuyển Text về đường tròn

    35 Di chuyển Text về đỉnh Line

    36 Di chuyển Text về điểm giữa Line

    37 Sao chép Text về điểm giữa Line

    38 Sao chép Text gần đỉnh Pline về đỉnh Pline

    39 Sao chép Text gần 2 đỉnh của Line gán vào 2 đỉnh Line

    40 Sao chép Text cao độ n lần theo số Text là mã địa vật

    41 Di chuyển Text ngẫu nhiên

    42 Tạo Text mã địa vật tại giao MCN với các đối tượng dạng đường, mã địa vật là tên Layer mà MCN giao cắt

    43 Tạo text giao giữa các đối tượng dạng đường từ 2 Layer khác nhau

    44 Tạo text tại nút giao

    45 Chọn tuyến trước khi thực hiện lệnh TTN (tìm Trắc Ngang ở phía dưới)

    46 Tìm vị trí Trắc Ngang tên tuyến từ Text lý trình trên MCN

    47 Mở vị trí mặt cắt ngang từ lúc gõ lệnh TTN phía trên

    48 Tạo khung in cho Trắc Dọc

    49 Update Line

    50 Vẽ Trắc Dọc

    51 Vẽ Trắc Ngang

    52 Tạo file ntd

    53 Đổi kích thước chữ

    54 Phóng to chữ theo tỷ lệ

    55 Xoay Text, Block theo tim tuyến

    56 Xoay bình đồ tuyến

    ....................

    • Like 1
×