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

thanhduan2407

Nhà quảng cáo
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1.161

  • Đã tham gia

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

  • Ngày trúng

    26

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

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

    7 phút trước, Doan Van Ha đã nói:

    Nó!

      

    
(defun C:AB()
 (initget "TDTP DTTP TPDT PTDT")
 (setq a (getkword (strcat "\nB\U+1EA1n mu\U+1ED1n \U+0111\U+00E1nh s\U+1ED1 hi\U+1EC7u theo ki\U+1EC3u n\U+00E0o?[TDTP - Tr\U+00EAn D\U+01B0\U+1EDBi - Tr\U+00E1i Ph\U+1EA3i /
               DTTP - D\U+01B0\U+1EDBi Tr\U+00EAn - Tr\U+00E1i Ph\U+1EA3i /
               TPDT - Tr\U+00E1i ?Ph\U+1EA?3i - D\U+01B0\U+1EDBi Tr\U+00EAn /
               PTDT - Ph\U+1EA3i Tr\U+00E1i - ?D\U+01B0\U+1EDB?i Tr\U+00EAn]?")))
 (cond
  ((= a "TDTP") (Ham1 3 5))               
  ((= a "DTTP") (Ham2 3 5))               
  ((= a "TPDT") (Ham3 3 5))               
  ((= a "PTDT") (Ham4 3 5))))
(defun Ham1 (x1 x2)
 (+ x1 x2))
(defun Ham2 (x1 x2)
 (- x1 x2))

     

    Dạ, cái x1 và x2 chưa xác định bác ạ!

    Cháu đang muốn xác định hàm phù hợp với lựa chọn bác ạ! Cháu không muốn lặp lại hàm.

     

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

    10 phút trước, beckakham333 đã nói:

    Em hiện tại đang bị vấn đề này, mong cao nhân chỉ giáo giúp em. Em hơi yếu công nghệ, mong được chỉ giáo cụ thể ạ. Em cảm ơn nhiều nhiều.

    Bạn copy dòng này rồi Paste vào dòng Command. Back ngược lại tìm đến Folder "Plot Styles".  Ở trên có đường link download file monochrome.ctb rồi. Copy dán vào đó là dc.

    (startapp "explorer" (vl-filename-directory (getvar 'FONTMAP)))

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

    Các bác cho em hỏi 1 chút!

    Em có các hàm:

    defun ham1(x1 x2 / ); defun ham2(x1 x2 / ); defun ham3(x1 x2 / ); defun ham4(x1 x2 / ),....

    Em đang làm 1 cái tuỳ chọn.

      (if (null *Style*)
        (setq *Style* "TDTP")
      )
      (initget "TDTP DTTP TPDT PTDT")
      (if (setq Style (getkword
                   (strcat "\nB\U+1EA1n mu\U+1ED1n \U+0111\U+00E1nh s\U+1ED1 hi\U+1EC7u theo ki\U+1EC3u n\U+00E0o?
                   [TDTP - Tr\U+00EAn D\U+01B0\U+1EDBi - Tr\U+00E1i Ph\U+1EA3i /
                   DTTP - D\U+01B0\U+1EDBi Tr\U+00EAn - Tr\U+00E1i Ph\U+1EA3i /
                   TPDT - Tr\U+00E1i Ph\U+1EA3i - D\U+01B0\U+1EDBi Tr\U+00EAn /
                   PTDT - Ph\U+1EA3i Tr\U+00E1i - D\U+01B0\U+1EDBi Tr\U+00EAn]
                   <"
                       *Style*
                       ">: "
                   )
                 )
          )
        (setq *Style* Style)
      )

    Em muốn làm cái tuỳ chọn như này nhưng sẽ là sai. Nhờ các bác chỉ dẫn dùm với ạ

    (cond
        ((= Style "TDTP")
         (setq Choose Ham1)
        )
        ((= Style "DTTP")
         (setq Choose Ham2)
        )
        ((= Style "TPDT")
         (setq Choose Ham3)
        )
        ((= Style "PTDT")
         (setq Choose Ham4)
        )
      )

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

    14 giờ trước, ngokiet đã nói:

    Hình như nó hỏi kiểu báo cho bạn biết có chương trình muốn sửa đổi file hay không?

    Cái này dùng để bảo vệ dữ liệu chống thay đổi trái phép của windows. Muốn ko hỏi thì phải tắt Uac đi.

    Tìm hiểu thêm về UAC trên Google nhé.

    Cảm ơn bác nhiều!

    Em sẽ nghiên cứu thêm ít nữa. Chưa thấy có tác dụng dù em làm thủ công nó vẫn hỏi.

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

    Các bác cho em hỏi 1 chút ạ!

    Em dùng Win 10, 64 bit. Em dùng lisp để rename hoặc copy ở Ổ C: mà các file không có động tĩnh gì?

    Về cấu trúc  vl-file-rename và vl-file-copy đều rất ổn. Phải chăng cần can thiệp về Permission cho phép tạo file hoặc đổi tên file?

    Bản thân em rename bằng tay, sau khi kết thúc thì máy tính cũng hỏi Yes or No.

    Mong nhờ các bác cho em sáng dạ thêm chút ạ. Hic hic

     

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

    Các bác cho em hỏi 1 xíu!

    Có cách nào để co cụm lại dòng lisp cho gọn được không ạ? Em cảm ơn nhiều!

    Ví dụ: 

    (defun MakeLayer_ (name colour /)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
    '(0 . "LAYER")
    '(100 . "AcDbSymbolTableRecord")
    '(100 . "AcDbLayerTableRecord")
    '(70 . 0)
    (cons 2 name)
    (cons 62 colour)
      )
    )
  )
)

     

    thành 

    (defun MakeLayer_ (name colour /)  (if (null (tblsearch "LAYER" name))    (entmake      (list    '(0 . "LAYER")    '(100 . "AcDbSymbolTableRecord")    '(100 . "AcDbLayerTableRecord")    '(70 . 0)    (cons 2 name)    (cons 62 colour)      )    )  ))

     

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

    Vào lúc 10/6/2019 tại 07:42, tnlinh09 đã nói:

    Chào các bác, cho em hỏi file cad địa hình của em không thể di chuyển hay xóa text trong đó. Bác nào biết chỉ giúp e với, e xin chân thành cảm ơn!!!

    Xref_DiaHinh.dwg

    Phá vỡ nó ra. Dấu chấm của đối tượng đó chính là Circle. Xuất toạ độ Z của đường tròn đó rồi phun lại text là được

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

    16 phút trước, monavamonava đã nói:

    Một trong 2 phương pháp đều ok cả. Làm cách nào hay vậy bác. Chỉ em cách tự động pick vào các mắt lưới với...

    1. Cái màu đỏ của bạn là Polyline nên muốn chèn nó vào phải tìm tâm của nó

    2. Cần xác định toạ độ các điểm giao mắt lưới

    3. Xác định các điểm giao đó nằm trong hay ngoài đường bao xanh.

    • Like 1

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

    Bạn dùng lisp này đóng 2 đầu đoạn đường cho nhanh 

    (defun C:00 (/ ELAST LTS1 LTS2 OBJ1 OBJ2 OLMODE PNTC1 PNTC2 PNTD1 PNTD2)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)

  (setq	Obj1
	 (car
	   (LM:SelectIf
	     "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng th\U+1EE9 nh\U+1EA5t:  "
	     (lambda (x)
	       (member (cdr (assoc 0 (entget (car x))))
		       (list "LINE" "POLYLINE" "LWPOLYLINE" "ARC" "ELLIPSE" "SPLINE")
	       )
	     )
	     entsel
	     nil
	   )
	 )
  )
  (setq	Obj2
	 (car
	   (LM:SelectIf
	     "\nCh\U+1ECDn \U+0111\U+01B0\U+1EDDng th\U+1EE9 hai:  "
	     (lambda (x)
	       (member (cdr (assoc 0 (entget (car x))))
		       (list "LINE" "POLYLINE" "LWPOLYLINE" "ARC" "ELLIPSE" "SPLINE")
	       )
	     )
	     entsel
	     nil
	   )
	 )
  )
  (setq	kch
	 (LM:GetXWithDefault
	   getdist
	   "\nNh\U+1EADp kho\U+1EA3ng c\U+00E1ch l\U+1EDBn h\U+01A1n s\U+1EBD kh\U+00F4ng n\U+1ED1i"
	   '*kch*
	   5.0
	 )
  )
  (setq Elast (entlast))
  (if (and Obj1 Obj2 (/= Obj1 Obj2))
    (progn
      (setq PntD1 (vlax-curve-getStartPoint Obj1))
      (setq PntC1 (vlax-curve-getEndPoint Obj1))
      (setq PntD2 (vlax-curve-getStartPoint Obj2))
      (setq PntC2 (vlax-curve-getEndPoint Obj2))
      (if (< (distance PntD1 PntD2) (distance PntD1 PntC2))
	(progn
	  (if (< (distance PntD1 PntD2) kch)
	    (MakeLWPolyline (list PntD1 PntD2) nil nil nil nil nil nil)
	  )
	  (if (< (distance PntC1 PntC2) kch)
	    (MakeLWPolyline (list PntD1 PntD2) nil nil nil nil nil nil)
	  )
	)
	(progn
	  (if (< (distance PntD1 PntC2) kch)
	    (MakeLWPolyline (list PntD1 PntC2) nil nil nil nil nil nil)
	  )
	  (if (< (distance PntC1 PntD2) kch)
	    (MakeLWPolyline (list PntC1 PntD2) nil nil nil nil nil nil)
	  )
	)
      )
    )
  )
  (setq Lts1 (GetNewEnts Elast))
  (setq Lts2 (append Lts1 (list Obj1 Obj2)))
  (if (member "LINE"
	      (list (cdr (assoc 0 (entget Obj1))) (cdr (assoc 0 (entget Obj2))))
      )
    (command "_.pedit" "_m" (CV:List-to-ss Lts2) "" "Y" "_j" "" "")
    (command "_.pedit" "_m" (CV:List-to-ss Lts2) "" "_j" "" "")
  )
  (setvar "OSMODE" Olmode)
  (princ)
)
(defun GetNewEnts (ename / new)
  (while (setq ename (entnext ename))
    (if	(entget ename)
      (setq new (cons ename new))
    )
  )
  new
)

(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
  (setq	Lst (list (cons 0 "LWPOLYLINE")
		  (cons 100 "AcDbEntity")
		  (cons	8
			(if Layer
			  Layer
			  (getvar "Clayer")
			)
		  )
		  (cons	6
			(if Linetype
			  Linetype
			  "bylayer"
			)
		  )
		  (cons	48
			(if LTScale
			  LTScale
			  1
			)
		  )
		  (cons	62
			(if Color
			  Color
			  256
			)
		  )
		  (cons 100 "AcDbPolyline")
		  (cons 90 (length listpoint))
		  (cons	70
			(if closed
			  1
			  0
			)
		  )
	    )
  )
  (foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
  (if xdata
    (setq Lst (append lst (list (cons -3 (list xdata)))))
  )
  (entmakex Lst)
)
(defun CV:List-to-ss (lst / ss)
  (setq ss (ssadd))
  (foreach item	lst
    (or	(= (type item) 'Ename)
	(setq item (vlax-vla-object->ename item))
    )
    (setq ss (ssadd item ss))
  )
  ss
)

(defun LM:SelectIf (msg pred func keyw / sel)
  (setq pred (eval pred))
  (while
    (progn
      (setvar 'ERRNO 0)
      (if keyw
	(apply 'initget keyw)
      )
      (setq sel (func msg))
      (cond
	((= 7 (getvar 'ERRNO))
	 (princ
	   "\nB\U+1EA1n ch\U+1ECDn sai r\U+1ED3i! H\U+00E3y ch\U+1ECDn l\U+1EA1i."
	 )
	)
	((eq 'STR (type sel))
	 nil
	)
	((vl-consp sel)
	 (if (and pred (not (pred sel)))
	   (princ "")
	 )
	)
      )
    )
  )
  sel
)
(defun LM:GetXWithDefault (_function _prompt _symbol _default / _toString)
  ;; © Lee Mac 2010

  (setq	_toString
	 (lambda (x)
	   (cond
	     ((eq getangle _function) (angtos x))
	     ((eq 'REAL (type x)) (rtos x))
	     ((eq 'INT (type x)) (itoa x))
	     (x)
	   )
	 )
  )

  (set _symbol
       (
	(lambda	(input)
	  (if (or (not input) (eq "" input))
	    (eval _symbol)
	    input
	  )
	)
	 (_function (strcat _prompt
			    "<"
			    (_toString (set _symbol
					    (cond ((eval _symbol))
						  (_default)
					    )
				       )
			    )
			    "> : "
		    )
	 )
       )
  )
)
 ;|«Visual LISP© Format Options»
(200 2 60 2 nil "end of " 80 9 0 0 0 T T T T)
;*** DO NOT add text below the comment! ***|;

     

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

    22 giờ trước, conghoa đã nói:

    Nó thuộc phạm trù về kỹ năng vẽ của bạn, cái này không cần lisp cũng làm nhanh được. Chỉ cần hiện riêng layer 0, Bo lại phần đường, dùng lệnh extrim là được.

     

    image.png.86c860d5cf02c484c4397e2cab26b7d8.png

     

     

    Theo kinh nghiệm của mình thì đường mòn trên núi không nên cắt TRIM như vậy, vừa xấu lại khó cho bên thiết kế tính toán. Thay vì điều đó, hãy Wipeout nó lại. Chỉ là che phủ phần đường,  vừa nhẹ nhàng lại đẹp. 
    Có phải bạn bổ sung con đường dựa trên bình đồ 1/10000 và 1/25000 không?

    Thuốc cho bạn đây!

    Lệnh WPL áp dụng cho Polyline

    Lệnh WPT áp dụng cho Text

    Link: https://www.mediafire.com/file/cp882xr222mg8mv/Wipeout_Polyline_(WPL)_and_Text_(WPT).VLX/file

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

    Vào lúc 3/4/2019 tại 14:14, Doan Van Ha đã nói:

    Cái này?

      

    

(defun C:TD(/ ss lst p1 gr code p2)
 (setq ss (ssget) lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) p1 (getpoint "\nChon diem chuan: "))
 (while (and (setq gr (grread T 4 0) code (car gr) p2 (cadr gr)) (not (= 3 code)) (not (= 25 code)))
  (cond
;----- TH1. Khi rª chuét trªn mµn h×nh.
   ((= 5 code) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst) (setq p1 p2))
;----- TH2. Khi pick point hoÆc chuét ph¶i.
   ((or (= 3 code) (= 25 code)) (mapcar '(lambda(obj) (vla-Move obj (vlax-3d-point p1) (vlax-3d-point p2))) lst))))
 (princ))

     

    Cháu cảm ơn bác Ha nhiều! Code mượt và dễ hiểu lắm ạ

×