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

Danh Cong

Moderator
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1.387

  • Đã tham gia

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

  • Ngày trúng

    117

Bài đăng được đăng bởi Danh Cong

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

    1. Nếu bạn đang vẽ và in trên Model : Ko cần quy luật gì sất, cứ nhìn thấy nét vẽ  + in thử ra PDF vài lần là có kinh nghiệm.

    2. Nếu bạn vẽ trên model, in trên Layout :

    Cái này thì khá đơn giản, bạn chỉnh toàn bộ Properties nét vẽ Line Type Scale = 1. Gõ lệnh LTS = 5. Thì khi in nét vẽ trên khổ giấy A3 khá cân đối.

    • Like 1

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

    21 giờ trước, TKTXVD đã nói:

    Bác Danh Cong & thanhtvgt ơi, lisp của 2 bác đánh lệnh cad nó không hiểu (CAD2007 & 2020) các bác có thể sửa đc ko

    Bạn copy các dòng code về dán vào file txt, rồi tự tạo file lisp ( Không nhấn nút dowload trên diễn đàn, diễn đàn đang bị lỗi ).

    Ngoài ra, để ý xem lisp có load được hay chưa, hoặc lisp không dùng được thì màn hình thông báo lỗi gì.

     

    • Like 1

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

    Code cho bạn, lisp này có thể đếm số lượng thép theo:

    1 : Theo khoảng cách

    2 ; Theo số lượng;

    3 : Theo khoảng cách, số lượng  với Dim đã bị sửa số; 

    


    
	(defun c:DEM ( / #DEM-KHOANG-CACH #DEM-SO-LUONG #DEMTHEP-NAME E1 E42 EDXF ENAME ENEW OBJECT)

    


    
	  (command "undo" "begin")

    


    
	  (or #DEMTHEP-NAME (setq #DEMTHEP-NAME "KHOANG-CACH-1"))

    


    
	  (initget "KHOANG-CACH-1 KHOANG-CACH-2 SO-LUONG-1 SO-LUONG-2 SUA-KHOANG-CACH SUA-SO-LUONG")

    


    
	  (setq #DEMTHEP-NAME (cond ((getkword (strcat "\nSelect Program: [KHOANG-CACH-1/KHOANG-CACH-2/SO-LUONG-1/SO-LUONG-2/SUA-KHOANG-CACH/SUA-SO-LUONG] <"#DEMTHEP-NAME">")))(#DEMTHEP-NAME)))

    


    
	 

    


    
	  (cond ((or (= #DEMTHEP-NAME "KHOANG-CACH-1") (= #DEMTHEP-NAME "KHOANG-CACH-2") (= #DEMTHEP-NAME "SUA-KHOANG-CACH"))

    


    
	(or #DEM-KHOANG-CACH (setq #DEM-KHOANG-CACH 150.0))

    


    
	  (setq #DEM-KHOANG-CACH (cond ((getreal (strcat "\nNhap khoang cach buoc thep: < " (rtos #DEM-KHOANG-CACH 2 0) " >:")))(#DEM-KHOANG-CACH))))

    


    
	      ((or (= #DEMTHEP-NAME "SO-LUONG-1") (= #DEMTHEP-NAME "SO-LUONG-2") (= #DEMTHEP-NAME "SUA-SO-LUONG"))

    


    
	(or #DEM-SO-LUONG (setq #DEM-SO-LUONG 10))

    


    
	  (setq #DEM-SO-LUONG (cond ((getreal (strcat "\nNhap so luong thanh thep: < " (rtos #DEM-SO-LUONG 2 0) " >:")))(#DEM-SO-LUONG))))

    


    
	      ); End Cond

    


    
	(setq Object (ssget'((0 . "DIMENSION"))))

    


    
	(repeat  (sslength Object)

    


    
	(setq Ename (ssname Object 0)

    


    
	       Edxf (entget Ename)

    


    
	       E42 (cdr (assoc 42 Edxf)))

    


    
	 (cond ((or (= #DEMTHEP-NAME "KHOANG-CACH-1") (= #DEMTHEP-NAME "KHOANG-CACH-2")) (setq E1 (/ E42 #DEM-KHOANG-CACH)))

    


    
	       ((or (= #DEMTHEP-NAME "SO-LUONG-1")    (= #DEMTHEP-NAME "SO-LUONG-2"))    (setq E1 (/ E42 #DEM-SO-LUONG)))

    


    
	       ((= #DEMTHEP-NAME "SUA-KHOANG-CACH")   (setq E1 (/ (atof (cdr (assoc 1 Edxf))) #DEM-KHOANG-CACH)))

    


    
	       ((= #DEMTHEP-NAME "SUA-SO-LUONG")      (setq E1 (/ (atof (cdr (assoc 1 Edxf))) #DEM-SO-LUONG))))

    


    
	 

    


    
	  (cond ((= #DEMTHEP-NAME "KHOANG-CACH-1") (setq Enew (subst (cons 1 (strcat (rtos E1 2 0) "X" (rtos #DEM-KHOANG-CACH 2 0) "=<>")) (assoc 1 Edxf) Edxf)))

    


    
	((= #DEMTHEP-NAME "KHOANG-CACH-2") (setq Enew (subst (cons 1 (strcat (rtos E1 2 0) "X" (rtos #DEM-KHOANG-CACH 2 0))) (assoc 1 Edxf) Edxf)))

    


    
	((= #DEMTHEP-NAME "SO-LUONG-1")    (setq Enew (subst (cons 1 (strcat (rtos #DEM-SO-LUONG 2 0) "X" (rtos E1 2 1) "=<>")) (assoc 1 Edxf) Edxf)))

    


    
	((= #DEMTHEP-NAME "SO-LUONG-2")    (setq Enew (subst (cons 1 (strcat (rtos #DEM-SO-LUONG 2 0) "X" (rtos E1 2 0))) (assoc 1 Edxf) Edxf)))

    


    
	((= #DEMTHEP-NAME "SUA-KHOANG-CACH")    (setq Enew (subst (cons 1 (strcat (rtos E1 2 0) "X" (rtos #DEM-KHOANG-CACH 2 0) "=" (cdr (assoc 1 Edxf)))) (assoc 1 Edxf) Edxf)))

    


    
	((= #DEMTHEP-NAME "SUA-SO-LUONG")    (setq Enew (subst (cons 1 (strcat (rtos #DEM-SO-LUONG 2 0) "X" (rtos E1 2 1) "=" (cdr (assoc 1 Edxf)))) (assoc 1 Edxf) Edxf))))

    


    
	  (entmod Enew)

    


    
	  (if (and (> (abs (- (* (atof (rtos E1 2 0)) #DEM-KHOANG-CACH) E42)) 0.1) (or (= #DEMTHEP-NAME "KHOANG-CACH-1")

    


    
	       (= #DEMTHEP-NAME "KHOANG-CACH-2")))

    


    
	    (vla-put-Textcolor (vlax-ename->vla-object Ename) 1)

    


    
	    (vla-put-Textcolor (vlax-ename->vla-object Ename) 3))

    


    
	  (ssdel Ename Object)

    


    
	  ); end repeat

    


    
	(command "undo" "end")

    


    
	(princ))
    • Like 1

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

    + Ở Cad đời mới thì việc lựa chọn vùng Hatch xong, thì viền ngoài của vùng Hatch được thể hiện "sáng lên". ( Hình 2 của bạn)

    + Với 1 số Cad đời cũ  ( Tôi dùng 2007 và 2012 ) thì viền ngoài của Hatch được thể hiện nét đứt.

    Tóm lại bạn cần tinh mắt 1 tí, là biết được vùng nào đã chọn :)) Tôi thấy ko mấy khó khăn .

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

    1. Bạn hiểu nôm na là lisp bị lỗi đi :))) Ko dùng được lisp này thì tìm lisp khác.

    2. Nếu công việc của bạn đơn giản là đưa Hatch xuống dưới đối tượng khác ; thì tại sao trước lúc tắt bản vẽ -->  Bạn đưa toàn bộ Hatch xuống dưới ?

    Thao tác này đơn giản chỉ là chọn Hatch ( Chọn nhiều thì dùng Filter ), Chuột phải  >> Draw Order , mất thêm vài giây là xong :)))

    • Like 1

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

    11 giờ trước, 790312 đã nói:

    Cảm ơn bác nhiều. Lisp chạy ok, nhưng nếu để nó là một file thì OK, còn nếu mình đưa nó vào chung file với một lisp khác thì nó k chạy. Mong các bác bỏ tí thời gian check giùm mình với. 

    
;; ===========SAP XEP DIM CACH DEU NHAU==============================

(defun c:sd ()
  (defun ss2ent	(ss / sodt index lstent)
    (setq
      sodt  (cond
	      (ss (sslength ss))
	      (t 0)
	    )
      index 0
    )
    (repeat sodt
      (setq ent	   (ssname ss index)
	    index  (1+ index)
	    lstent (cons ent lstent)
      )
    )
    (reverse lstent)
  )
  (defun hoanh_newerror	(msg)
    (if	(and (/= msg "Function cancelled")
	     (/= msg "quit / exit abort")
	)
      (princ (strcat "\n" msg))
    )
    (done)
  )
  ;;----------
  (defun init ()
    (setq
      HOANH_CMD	     (getvar "CMDECHO")
      HOANH_OLDERROR *error*
      *error*	     hoanh_newerror

    )
    (setvar "CMDECHO" 0)
    (command ".undo" "BE")
  )
  ;;----------
  (defun done ()
    (command ".redraw")
    (command ".undo" "E")
    (if	HOANH_CMD
      (setvar "CMDECHO" HOANH_CMD)
    )
    (if	HOANH_OLDERROR
      (setq *error* HOANH_OLDERROR)
    )
    (princ)
  )
  ;;----------

  (defun cdim (entdt	pchan	 pduong	  /	   tt	    old10
	       old13	old14	 new10	  new13	   new14    p10n
	       p13n	p14n	 p10o	  p13o	   p14o	    gocduong
	       gocchan	pchanb	 pduongb  loaidim
	      )
    (defun chanvuonggoc	(ph p1 p2 / ptemp pkq goc)
      (setq
	goc   (+ (angle p1 p2) (/ pi 2.0))
	ptemp (polar ph goc 1000.0)
	pkq   (inters ph ptemp p1 p2 nil)
      )
      pkq
    )
    (setq
      tt       (entget entdt)
      old10    (assoc '10 tt)
      old13    (assoc '13 tt)
      old14    (assoc '14 tt)
      p10o     (cdr old10)
      p13o     (cdr old13)
      p14o     (cdr old14)
      loaidim  (logand (cdr (assoc '70 tt)) 7)
      gocduong (cond
		 ((= loaidim 1) (angle p13o p14o))
		 ((= loaidim 0) (cdr (assoc '50 tt)))
		 (t nil)
	       )
      pchan    (cond
		 (pchan (list (car pchan) (cadr pchan) 0.0))
		 (t pchan)
	       )
      pduong   (cond
		 (pduong (list (car pduong) (cadr pduong) 0.0))
		 (t pduong)
	       )

    )
    (if	gocduong
      (progn
	(if pchan
	  (setq
	    pchanb (polar pchan gocduong 1000.0)
	    p13n   (chanvuonggoc
		     (list (car p13o) (cadr p13o) 0.0)
		     pchan
		     pchanb
		   )
	    p14n   (chanvuonggoc
		     (list (car p14o) (cadr p14o) 0.0)
		     pchan
		     pchanb
		   )
	    new13  (cons 13 p13n)
	    new14  (cons 14 p14n)
	    tt	   (subst new13 old13 tt)
	    tt	   (subst new14 old14 tt)
	  )
	)
	(if pduong
	  (setq
	    pduongb (polar pduong gocduong 1000.0)
	    p10n    (chanvuonggoc
		      (list (car p10o) (cadr p10o) 0.0)
		      pduong
		      pduongb
		    )
	    new10   (cons 10 p10n)
	    tt	    (subst new10 old10 tt)
	  )
	)
	(entmod tt)
      )
    )
    gocduong
  )

  (defun textdimheight (ent / tmp)
    (command ".copy" ent "" (list 0.0 0.0 0.0) "@")
    (command ".explode" (entlast) "")
    (setq tmp (cdr (assoc 40 (entget (entlast)))))
    (command ".erase" "p" "")
    tmp
  )
  (defun phia (p1 p2 p3 / x1 y1 z1 x2 y2 z2 x3 y3 z3)
    (setq
      x1  (car p1)
      y1  (cadr p1)
      z1  (caddr p1)
      x2  (car p2)
      y2  (cadr p2)
      z2  (caddr p2)
      x3  (car p3)
      y3  (cadr p3)
      z3  (caddr p3)
      tmp (+ (* (- x1 x2) x3)
	     (* (- y1 y2) y3)
	     (* (- z1 z2) z3)
	  )
    )
    (cond
      ((= tmp 0.0) 0.0)
      (t (/ tmp (abs tmp)))
    )
  )
  (defun khoangcachdim (p1 ent goc / tt p2 A B D)
    (setq tt (entget ent)
	  p2 (cdr (assoc 10 tt))
	  B  (cdr (assoc 50 tt))
	  A  (angle p1 p2)
	  D  (distance p1 p2)
    )
    (* (* D (sin (- A B))) (phia p1 (polar p1 goc 1.0) p2))
  )

  (defun phanloai (ent)
    (setq
      kc   (khoangcachdim pgoc ent goc)
      loai (fix (/ kc heightdimgoc 0.93))
    )
    (cons loai ent)
  )

  (init)
  (princ "\nSap xep dim © CADViet.com")
  (while (not (setq entgoc (car (entsel "\nSelect orginal dimension: "))))
  )
  (setq
    ttgoc	 (entget entgoc)
    p13goc	 (cdr (assoc 13 ttgoc))
    pgoc	 (cdr (assoc 10 ttgoc))
    goc		 (cdr (assoc 50 ttgoc))
    heightdimgoc (textdimheight entgoc)
    ssd		 (ssget	(list
			  (cons 0 "DIMENSION")
			  (cons -4 "<OR")
			  (cons 70 32)
			  (cons 70 64)
			  (cons 70 96)
			  (cons 70 128)
			  (cons 70 160)
			  (cons 70 196)
			  (cons 70 224)
			  (cons -4 "OR>")
			  (cons -4 "<OR")
			  (cons 50 goc)
			  (cons 50 (+ goc pi))
			  (cons 50 (- goc pi))
			  (cons -4 "OR>")
			)
		 )
    lstd	 (ss2ent ssd)
    lstd	 (mapcar 'phanloai lstd)
    lstlevel	 nil
  )
  (foreach pp lstd
    (if	(not (member (car pp) lstlevel))
      (setq lstlevel (append lstlevel (list (car pp))))
    )
  )
  (setq	lstlevel    (vl-sort lstlevel '(lambda (x1 x2) (< x1 x2)))
	lstam	    nil
	lstduong    nil
	lstamtmp    nil
	lstduongtmp nil
  )
  (foreach pp lstlevel
    (if	(< pp 0.0)
      (setq lstam (append lstam (list pp)))
    )
    (if	(> pp 0.0)
      (setq lstduong (append lstduong (list pp)))
    )
  )
  (setq index 0)
  (foreach pp (reverse lstam)
    (setq
      index    (1+ index)
      lstamtmp (append lstamtmp (list (cons pp index)))
    )
  )
  (setq
    lstam lstamtmp
    index 0
  )
  (foreach pp lstduong
    (setq
      index	  (1+ index)
      lstduongtmp (append lstduongtmp (list (cons pp index)))
    )
  )
  (setq lstduong lstduongtmp)
  (setq lstlevel (append lstduong lstam (list (cons 0.0 0))))

  (setq kcdimstandard (* 2.8 heightdimgoc))
  (foreach pp lstd
    (setq plht (car pp))
    (progn
      (setq
	kcdimht	   (khoangcachdim pgoc (cdr pp) goc)
	duongthu   (cdr (assoc plht lstlevel))
	heso	   (cond
		     ((/= 0 kcdimht)
		      (abs (* (/ kcdimstandard kcdimht) duongthu))
		     )
		     (t 0.0)
		   )
	diemchenht (cdr (assoc 10 (entget (cdr pp))))
	pmoi	   (polar pgoc
			  (angle pgoc diemchenht)
			  (* heso (distance pgoc diemchenht))
		   )
      )

      (cdim (cdr pp) p13goc pmoi)
    )
  )
  (done)
)
(princ)
)

;; free lisp from cadviet.com
; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-đã-xong-lisp-vẽ-pline-mũi-tên-2-đầu/
	(defun c:sline (/ loop p1 p2 lstPnt)   
	 (grtext -1 "Free from Cadviet.com @Ketxu")
	 (setq lstPnt '())
	 (if (not asize) (setq asize 1))      
	 (if (not PThk)  (setq PThk 0.01))                 
	 (defun GETR (val msg / tm)
	   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
	   (cond ((= (type tm) 'REAL) (eval tm))
	         ((= tm nil) (eval val))
	         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
	 (defun loop ()
	   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command "non" p2) 
	                                    (setq p0 p1) (setq p1 p2) (loop))
	         ( t (command "u" (polar p1 (angle p1 p0) asize)
	                      "w" (/ asize 3) 0.0 "non" p1 ""))))
	 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
	 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
	 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
	 (setq lstPnt (append (list p1) lstPnt))
	 (command "pline" "non" p1 "w" 0.0 0.0)
	 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
	 (setq lstPnt (append (list p2) lstPnt))
	 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
	          "w" PThk PThk "non" p2)
	 (setq p1 p2)
	 (loop)
	(if  (ST:Geo-ListLinear lstPnt)
	(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
	)
	 (eval "Done")
	)
	(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
	 (
	   (lambda ( a b c )
	     (or
	       (equal (+ a B) c fuzz)
	       (equal (+ b c) a fuzz)
	       (equal (+ c a) b fuzz)
	     )
	   )
	   (distance p1 p2) (distance p2 p3) (distance p1 p3)
	 )
	)
	(defun ST:Geo-ListLinear (lst / tmp)
	(setq i 2)
	(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
	    (T (while (and (< i (1- (length lst)))
	            (setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
	            tmp
	        )
	    )
	)
	tmp
	)
	(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))

    Lisp SD lỗi.

    • Vote tăng 1

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

    Vào lúc 12/2/2020 tại 05:55, 790312 đã nói:

    Cảm ơn bác đã bỏ thời gian check. Nhưng bác sử dụng lisp này vẽ mũi tên xong, sau đó bác zoom nhỏ hình lại và vẽ đoạn thẳng khác dài hơn thì nó sẽ bị lỗi là chỉ vẽ mũi tên ở một đầu thôi bác ah. E gửi bác lisp e down ở bài 12 từ trên xuống của chính chủ, bác check như e nói xem. Cảm ơn bác nhiều. 

    
;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-%C4%91%C3%A3-xong-lisp-v%E1%BA%BD-pline-m%C5%A9i-t%C3%AAn-2-%C4%91%E1%BA%A7u/
(defun c:sline (/ loop p1 p2 lstPnt)   
 (grtext -1 "Free from Cadviet.com @Ketxu")
 (setq lstPnt '())
 (if (not asize) (setq asize 1))      
 (if (not PThk)  (setq PThk 0.01))                 
 (defun GETR (val msg / tm)
   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
   (cond ((= (type tm) 'REAL) (eval tm))
         ((= tm nil) (eval val))
         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
 (defun loop ()
   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command p2) 
                                    (setq p0 p1) (setq p1 p2) (loop))
         ( t (command "u" (polar p1 (angle p1 p0) asize)
                      "w" (/ asize 3) 0.0 p1 ""))))
 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
 (setq lstPnt (append (list p1) lstPnt))
 (command "pline" p1 "w" 0.0 0.0)
 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
 (setq lstPnt (append (list p2) lstPnt))
 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
          "w" PThk PThk p2)
 (setq p1 p2)
 (loop)
(if  (ST:Geo-ListLinear lstPnt)
(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
)
 (eval "Done")
)
(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
 (
   (lambda ( a b c )
     (or
       (equal (+ a B) c fuzz)
       (equal (+ b c) a fuzz)
       (equal (+ c a) b fuzz)
     )
   )
   (distance p1 p2) (distance p2 p3) (distance p1 p3)
 )
)
(defun ST:Geo-ListLinear (lst / tmp)
(setq i 2)
(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
	(T (while (and (< i (1- (length lst)))
			(setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
			tmp
		)
	)
)
tmp
)
(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))

    Đúng là có lúc lisp lỗi thật, đúng như bác NTDNV nói trên. Lỗi thì do anh KetXu chưa xử lý chế độ bắt điểm khi viết lisp thôi.

    Tôi sửa thêm 1 số chỗ về bắt điểm nữa, bạn có thể tải về kiểm tra: 

    


    
	;; free lisp from cadviet.com
    
	;; this lisp was downloaded from https://www.cadviet.com/forum/topic/47541-đã-xong-lisp-vẽ-pline-mũi-tên-2-đầu/
    
	(defun c:sline (/ loop p1 p2 lstPnt)   
    
	 (grtext -1 "Free from Cadviet.com @Ketxu")
    
	 (setq lstPnt '())
    
	 (if (not asize) (setq asize 1))      
    
	 (if (not PThk)  (setq PThk 0.01))                 
    
	 (defun GETR (val msg / tm)
    
	   (setq tm (getreal (strcat msg " <" (rtos val 2 4) ">: ")))
    
	   (cond ((= (type tm) 'REAL) (eval tm))
    
	         ((= tm nil) (eval val))
    
	         (t (princ "\007 *error* Nh\U+1EADp sai lo\U+1EA1i d\U+1EEF li\U+1EC7u") (eval val)) ) )
    
	 (defun loop ()
    
	   (cond ((and(setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))(setq lstPnt (append (list p2) lstPnt))) (command "non" p2) 
    
	                                    (setq p0 p1) (setq p1 p2) (loop))
    
	         ( t (command "u" (polar p1 (angle p1 p0) asize)
    
	                      "w" (/ asize 3) 0.0 "non" p1 ""))))
    
	 (setq asize (getr asize "\nK\U+00EDch th\U+01B0\U+1EDBc m\U+0169i t\U+00EAn :"))
    
	 (setq PThk  (getr PThk "\n B\U+1EC1 r\U+1ED9ng PLine :"))
    
	 (setq p1 (getpoint "\n\U+0110i\U+1EC3m b\U+1EAFt \U+0111\U+1EA7u : "))
    
	 (setq lstPnt (append (list p1) lstPnt))
    
	 (command "pline" "non" p1 "w" 0.0 0.0)
    
	 (setq p2 (getpoint p1 "\n\U+0110i\U+1EC3m ti\U+1EBFp theo : "))
    
	 (setq lstPnt (append (list p2) lstPnt))
    
	 (command "w" 0.0 (/ asize 3) (polar p1 (angle p1 p2) asize) 
    
	          "w" PThk PThk "non" p2)
    
	 (setq p1 p2)
    
	 (loop)
    
	(if  (ST:Geo-ListLinear lstPnt)
    
	(foreach pt (cdr (vl-remove (last lstPnt) lstPnt)) (ST:Entmake-Circle pt 50))
    
	)
    
	 (eval "Done")
    
	)
    
	(defun ST:Geo-Linear ( p1 p2 p3 fuzz)
    
	 (
    
	   (lambda ( a b c )
    
	     (or
    
	       (equal (+ a B) c fuzz)
    
	       (equal (+ b c) a fuzz)
    
	       (equal (+ c a) b fuzz)
    
	     )
    
	   )
    
	   (distance p1 p2) (distance p2 p3) (distance p1 p3)
    
	 )
    
	)
    
	(defun ST:Geo-ListLinear (lst / tmp)
    
	(setq i 2)
    
	(cond ((and (= (length lst) 3)(ST:Geo-Linear(car lst)(cadr lst)(caddr lst) 1e-8))(setq tmp T))
    
	    (T (while (and (< i (1- (length lst)))
    
	            (setq tmp (ST:Geo-Linear (nth 0 lst)(nth 1 lst) (nth (setq i (1+ i)) lst) 1e-8)))
    
	            tmp
    
	        )
    
	    )
    
	)
    
	tmp
    
	)
    
	(defun ST:Entmake-Circle ( Pt Rad )(entmakex (list '(0 . "CIRCLE") (cons 10 pt)(cons 40 Rad))))v
    • Vote tăng 1

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

    4 phút trước, VoHoan đã nói:

    Bác nào viết đoạn code giúp mình thay đổi thông số của 1 layer với, VD thay đổi màu sắc, kiểu đường nét ...

    Thông số có rất nhiều loại,ví dụ nét đứt, nét kiền,tim, chấm mảnh... Trừ khi bản thân theo 1 loại mẫu nhất định, chứ yêu cầu của bạn khó đoán quá :)))

    • Like 1

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

    1 giờ} trướ}c, Hoangnhanst đã nói:

    Mong được giúp đỡ

     

    thank mn nhiều!

    Tôi góp ý thôi ^^

    Yêu cầu của bạn đừng nên mang tính cá nhân quá :))

    Bạn nên tách ra,lisp 1 là đo vuông góc, lisp 2 chọn các Dim rồi trừ đi 1 số.

    Rõ ràng 2 lisp sẽ có nhiều người sử dụng hơn là gộp cả 2 để phục vụ mỗi bạn :)))

     

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

    18 giờ trước, doductiep đã nói:

    Cảm ơn bác. Erase với fence đã giải quyết được. Vậy mà khi gõ lệnh trong cad sao nó không hiển thị các lựa chọn này nhỉ

    + Nó bị ẩn khi con trỏ chuột đang hiện chữ "Select".

    Bạn muốn nó hiện thì gõ 1 chữ loằng ngoằng như "abc" rồi đọc thanh command bên dưới xem nó nói gì :)))

    • Like 1

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

    9 giờ trước, VoHoan đã nói:

    Tiện đây cho mình hỏi code trong lisp để mặc định khi chạy lisp thì trả về đơn vị hệ "metters" với!

    Bạn viết lisp với biến hệ thống trong Cad:    (setvar "INSUNITS" 6)

     

    Specifies a drawing-units value for automatic scaling of blocks, images, or xrefs inserted or attached to a drawing.

    Note: The INSUNITS setting is ignored when inserting annotative blocks into a drawing.

    0    Unspecified (No units)
    1    Inches
    2    Feet
    3    Miles
    4    Millimeters
    5    Centimeters
    6    Meters
    7    Kilometers
    8    Microinches
    9    Mils
    10    Yards
    11    Angstroms
    12    Nanometers
    13    Microns
    14    Decimeters
    15    Decameters
    16    Hectometers
    17    Gigameters
    18    Astronomical Units
    19    Light Years
    20    Parsecs

    • Like 1
×