Jump to content
InfoFile
Tác giả: thanhduan2407
Bài viết gốc: 307031
Tên lệnh: td
Xin lisp lọc chọn các số trong khoảng AB

Viết cho các bạn đây.

(defun c:TD(/ SSchon Lts_so a b LtsInAB )
(setq ssChon  (ssget (list (cons 0 "TEXT"))))
(setq ss_So  (ChonTextSo ssChon))
(setq Lts_so (acet-ss-to-list ss_So))
(setq a (getreal "\nNhap so nho: "))
(setq b (getreal "\nNhap so lon: "))
(setq LtsInAB (vl-remove nil (mapcar '(lambda(x) (if (and ( > (atof (cdr (assoc 1 (entget x)))) a) ( < (atof (cdr (assoc 1 (entget x)))) b)) x nil)) Lts_so)))
(command...
>>

Viết cho các bạn đây.

(defun c:TD(/ SSchon Lts_so a b LtsInAB )
(setq ssChon  (ssget (list (cons 0 "TEXT"))))
(setq ss_So  (ChonTextSo ssChon))
(setq Lts_so (acet-ss-to-list ss_So))
(setq a (getreal "\nNhap so nho: "))
(setq b (getreal "\nNhap so lon: "))
(setq LtsInAB (vl-remove nil (mapcar '(lambda(x) (if (and ( > (atof (cdr (assoc 1 (entget x)))) a) ( < (atof (cdr (assoc 1 (entget x)))) b)) x nil)) Lts_so)))
(command "_.PSELECT" (acet-list-to-ss LtsInAB) "")
(princ)
)
(defun ChonTextSo (ss / i ent str ss1) 
    (progn
      (setq i	0
	    ss1	(ssadd)
      )
      (repeat (sslength ss)
	(setq ent (ssname ss i)
	      str (cdr(assoc 1 (entget ent)))
	      i	  (+ 1 i)
	)
	(if (distof str 2)
	  (ssadd ent ss1)
	)
      )
      (if (> (sslength ss1) 0)
	ss1
      )      
    )
)

 

(defun c:TD(/ SSchon Lts_so a b LtsInAB )
(setq ssChon  (ssget))
(setq ss_So  (ChonTextSo ssChon))
(setq Lts_so (acet-ss-to-list ss_So))
(setq a (getreal "\nNhap so nho: "))
(setq b (getreal "\nNhap so lon: "))
(setq LtsInAB (vl-remove nil (mapcar '(lambda(x) (if (and ( > (atof (cdr (assoc 1 (entget x)))) a) ( < (atof (cdr (assoc 1 (entget x)))) B)) x nil)) Lts_so)))
(command "_.PSELECT" (acet-list-to-ss LtsInAB) "")
(princ)
)
(defun ChonTextSo (ss / i ent str ss1) 
    (progn
      (setq i 0
   ss1 (ssadd)
      )
      (repeat (sslength ss)
(setq ent (ssname ss i)
     str (cdr(assoc 1 (entget ent)))
     i  (+ 1 i)
)
(if (distof str 2)
 (ssadd ent ss1)
)
      )
      (if (> (sslength ss1) 0)
ss1
      )      
    )
)

<<

Filename: 307031_td.lsp
Tác giả: Tot77
Bài viết gốc: 307114
Tên lệnh: cvp
lisp chia viewport trong layout

Bạn thử cái này. Chọn viewport trong layout, nhấp chọn điểm a, kéo ngang thì chia làm 2 vp theo phương ngang, kéo đứng thì chia 2 vp theo phương đứng, còn enter thì chia thành 4 viewport tại a.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b)
   ...
>>

Bạn thử cái này. Chọn viewport trong layout, nhấp chọn điểm a, kéo ngang thì chia làm 2 vp theo phương ngang, kéo đứng thì chia 2 vp theo phương đứng, còn enter thì chia thành 4 viewport tại a.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b)
    (command "mview" a b)
    (vla-put-CustomScale (vlax-ename->vla-object (entlast)) (/ 1.0 tyle))    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

<<

Filename: 307114_cvp.lsp
Tác giả: ndtnv
Bài viết gốc: 307070
Tên lệnh: s1 s2
Xin lisp lọc chọn các số trong khoảng AB

Lisp có nhiều đoạn có thể rút gọn.

Tôi bổ sung thêm 1 hàm có thể chọn số trong đoạn

 

(defun c:s1() (SelRange <))
(defun c:s2() (SelRange <=))

(defun SelRange(f / ss a b)
    (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT")))))
    (setq a (getreal "\nNhap so nho: ") b (getreal "\nNhap so lon: "))
    (command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x) (if (f a...
>>

Lisp có nhiều đoạn có thể rút gọn.

Tôi bổ sung thêm 1 hàm có thể chọn số trong đoạn

 

(defun c:s1() (SelRange <))
(defun c:s2() (SelRange <=))

(defun SelRange(f / ss a b)
    (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT")))))
    (setq a (getreal "\nNhap so nho: ") b (getreal "\nNhap so lon: "))
    (command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x) (if (f a (distof (cdr (assoc 1 (entget x)))) b) x nil)) ss))) "")
    (princ)
)
 

<<

Filename: 307070_s1_s2.lsp
Tác giả: Tot77
Bài viết gốc: 301119
Tên lệnh: tnn
VIẾT LISP KÉO DÀI, CẮT BỚT NHIỀU ĐỐI TƯỢNG!

Vậy bạn thử cái này, chỉ dùng với line thôi, và khi giao điểm của 2 line ở gần, chứ không thể kéo dài tới vô cực được.

 

 
(defun C:tnn(/ ss n sli vn tm)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun midp(v / d1 d2) (setq d1 (dxf 10 v) d2 (dxf 11 v))
    (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
  
  (defun ints (o1 o2 mo / l0 l)
    (setq l (vlax-Invoke...
>>

Vậy bạn thử cái này, chỉ dùng với line thôi, và khi giao điểm của 2 line ở gần, chứ không thể kéo dài tới vô cực được.

 

 
(defun C:tnn(/ ss n sli vn tm)
  (defun dxf(id v) (cdr (assoc id (entget v))))
  (defun midp(v / d1 d2) (setq d1 (dxf 10 v) d2 (dxf 11 v))
    (polar d1 (angle d1 d2) (* 0.5 (distance d1 d2))))
  
  (defun ints (o1 o2 mo / l0 l)
    (setq l (vlax-Invoke (vlax-EName->vla-Object o1) "IntersectWith" (vlax-EName->vla-Object o2) mo)
l0 nil)
    (while l
      (setq l0 (append l0 (list (list (car l) (cadr l) (caddr l))))
    l (cdddr l)))
    l0
  )
  ;;;
  (setq ss (ssget '((0 . "LINE"))))
  (command "fillet" "r" 0)
  (if (and ss (= (sslength ss) 2))
    (command "fillet"  (list (ssname ss 0) (midp (ssname ss 0)))
    (list (ssname ss 1) (midp (ssname ss 1))))
    (progn
      (setq n -1 sli (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (while (< n (1- (length sli)))
        (setq vn (nth (setq n (1+ n)) sli))
        (foreach v sli
 (setq tm (vlax-curve-getDistAtParam v (vlax-curve-getEndParam v)))
          (if (vl-remove-if-not '(lambda(x) (or (< (distance x (dxf 10 v)) tm)
(< (distance x (dxf 11 v)) tm))) (ints vn v acExtendBoth))
   (command "fillet"  (list v (midp v)) (list vn (midp vn))) ))
        
      )
    )
  )
)
 

<<

Filename: 301119_tnn.lsp
Tác giả: ketxu
Bài viết gốc: 307344
Tên lệnh: atrai aphai
Nhờ các bác viết giúp em cái lisp đánh số thứ tự từ trái
(defun c:atrai()(add <=))
(defun c:aphai()(add >=))
(defun add(dir / i  ss h _cen _t _sort)
	(defun _cen (v / p1 p2)
		(vla-getboundingbox (vlax-ename->vla-object v) 'p1 'p2)
		(mapcar '* (mapcar '+ (vlax-safearray->list p1) (vlax-safearray->list p2)) '(0.5 0.5 0.5))		
	)
	(defun _t (?where p s h / o )
		(setq o (vla-addtext ?where s (setq p (vlax-3D-point p)) h))
		(vla-put-alignment o acalignmentmiddlecenter)
		(vla-put-textalignmentpoint o...
>>
(defun c:atrai()(add <=))
(defun c:aphai()(add >=))
(defun add(dir / i  ss h _cen _t _sort)
	(defun _cen (v / p1 p2)
		(vla-getboundingbox (vlax-ename->vla-object v) 'p1 'p2)
		(mapcar '* (mapcar '+ (vlax-safearray->list p1) (vlax-safearray->list p2)) '(0.5 0.5 0.5))		
	)
	(defun _t (?where p s h / o )
		(setq o (vla-addtext ?where s (setq p (vlax-3D-point p)) h))
		(vla-put-alignment o acalignmentmiddlecenter)
		(vla-put-textalignmentpoint o p)    
	 )
	(defun _sort(f lst)(vl-sort lst '(lambda(x y)(f (car x) (car y)))))
	(setq 	i 0		 
			sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
			ss (ssget '((0 . "LWPOLYLINE")(70 . 1)))
			h (getvar 'Textsize)			 
	)
	(mapcar
		'(lambda(c)(_t sp c (itoa (setq i (1+ i))) h))	
			(_sort dir (mapcar '_cen (acet-ss-to-list ss)))
	)
	(princ)
) 

 

Quick code cho bạn. Vì khái niệm tâm rất mơ hồ, mình sẽ lấy tạm là tâm của boundingbox đối tượng, add chữ Dtext như bản vẽ, chiều cao lấy theo biến hệ thống Textsize.
 


<<

Filename: 307344_atrai_aphai.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 307486
Tên lệnh: xtxt1
XUAT TEXT SANG EXCEL

Xin chào cả nhà,

Mình xin bổ sung như sau:

- Mình muốn xuất các số trong các hình màu đỏ: Đường tròn, elip, lục giác.

- Mình sẽ click lần lượt các biểu tượng trên line1, bao gồm cả text: line1. Cụ thể thứ tự click sẽ là : "line1", 50, 30, 150, 530.

- Sau đó đến line2,........

-...

>>

Xin chào cả nhà,

Mình xin bổ sung như sau:

- Mình muốn xuất các số trong các hình màu đỏ: Đường tròn, elip, lục giác.

- Mình sẽ click lần lượt các biểu tượng trên line1, bao gồm cả text: line1. Cụ thể thứ tự click sẽ là : "line1", 50, 30, 150, 530.

- Sau đó đến line2,........

- line3,...

 

- Mình cũng đã tham khảo lisp xtxt của mod phamthanhbinh. Cách thức hoàn toàn tương tự như lisp. Nhưng lisp này không xử lý triệt để vấn đề của mình vì khi xuất ra thì chỉ có giá trị: line1, 50, 30, 150, 530.

- Mình muốn khi xuất ra, các giá trị trong hình tròn sẽ được thêm ký tự C, elip sẽ thêm ký tự E, hình lục giác sẽ thêm ký tự H.

 

Mong nhận được sự giúp đỡ 

 

P/s: Xin được phép up lại lisp của mod phamthanhbinh để mọi người có cơ sở giúp mình.

http://www.cadviet.com/upfiles/3/5666_xtxt.lsp

 

Trân trọng.

Hề hề hề,

Bạn hãy dùng thử lisp sau đây và cho ý kiến để mình hoàn thiện nó nhé.

Đây là bản mình viết nháp xem đã đúng ý bạn chưa nên mình chưa khử biến và cũng chưa test kỹ cho các trường hợp khác nhau.

Nếu bạn thấy phù hợp với ý định của bạn mình sẽ hoàn thiện sau nhé.

(defun c:xtxt1 ()
(setq dlst (list)
          tlst (list)
          ans "Y" )
(alert "Ban hay chon lan luot cac text can xuat cua tung line")
(while (= (strcase ans) "Y")
      (while (setq e (car (entsel)))
            (setq elst (entget e)
                      la (cdr (assoc 8 elst))
                      txt (cdr (assoc 1 elst)) )
            (cond 
                ((= la "PRT Points Red") (setq txt (strcat txt "- H")))
                ((= la "UTG Points Red") (setq txt (strcat txt "-C")))
                ((= la "UTS Points Red") (setq txt (strcat txt "-E")))
                (T nil)
            )
            (setq tlst (append tlst (list txt)))
       )
       (setq dlst (append dlst (list tlst)))
       (setq tlst (list))
       (setq ans (getstring "/n Ban muon tiep tuc chon line khac <Y or N>: "))
)
(setq ilst (list))
(foreach lst dlst
    (setq ilst (append ilst (list (length lst))))
)
(setq i (car (vl-sort ilst '(lambda (x y) (> x y)))))
(setq n 0)
(setq prlst (list))
(while (< n i)
     (setq dalst (mapcar '(lambda (x) (strcat (if (nth n x) (nth n x) " ") (chr 44))) dlst))
     (setq prlst (append prlst (list dalst)))
     (setq n (1+ n))
)
(setq  fn (getfiled "Select Data File" "" "csv" 1)
          f (open fn "w") )  
(foreach dat prlst  
     (setq tpr "")
     (foreach tp dat
          (setq tpr (strcat tpr tp))
     )
     (write-line tpr f)
)
(close f)
(princ)
)

 

Chúc bạn vui.


<<

Filename: 307486_xtxt1.lsp
Tác giả: Tot77
Bài viết gốc: 307574
Tên lệnh: cvp
lisp chia viewport trong layout

Bạn dùng cái này.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c layer)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b / obj)
    (command "mview" a b)
    (vla-put-CustomScale (setq obj (vlax-ename->vla-object (entlast))) (/ 1.0 tyle))
    (vla-put-Layer obj layer)    
    (command "MSPACE")
    (command "zoom"...
>>

Bạn dùng cái này.

(defun c:cvp(/ os vp tt10 tt12 tt40 tt41 tyle p1 p2 b c layer)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun dtim (pt) (polar tt12 (angle tt10 pt) (* tyle (distance tt10 pt))))
  (defun make (a b / obj)
    (command "mview" a b)
    (vla-put-CustomScale (setq obj (vlax-ename->vla-object (entlast))) (/ 1.0 tyle))
    (vla-put-Layer obj layer)    
    (command "MSPACE")
    (command "zoom" (dtim a) (dtim b))
    (command "PSPACE")
    (vla-put-DisplayLocked obj :vlax-true)
  )
  
  (command "undo" "be")
  (setq os (getvar 'osmode))
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 1 0 0 0))
  (setq vp  (car (entsel "\nChon viewport: "))
tt10 (dxf 10 vp)
tt12 (dxf 12 vp)
tt40 (dxf 40 vp)
tt41 (dxf 41 vp)
layer (dxf 8 vp)
tyle (/ (dxf 45 vp) tt41 1.0)
p1 (polar (polar tt10 pi (* 0.5 tt40)) (* -0.5 pi) (* 0.5 tt41))
p2 (polar (polar tt10 0 (* 0.5 tt40)) (* 0.5 pi) (* 0.5 tt41))
b (getpoint "\Diem chia: ")
c (getpoint b "\nTheo huong <Enter neu chia 4>: "))
 
  (cond ((eq (car b) (car c))
           (make p1 (list (car b) (cadr p2)))
  (make (list (car b) (cadr p1)) p2))
 
((eq (cadr b) (cadr c)) 
           (make p1 (list (car p2) (cadr b)))
  (make (list (car p1) (cadr b)) p2))
 
        (t (make p1 b) (make b p2)
  (make b (list (car p1) (cadr p2)))
  (make b (list (car p2) (cadr p1))))
  )
  (entdel vp)
  (command "undo" "e")
  (mapcar 'setvar (list 'orthomode 'tilemode 'cmdecho 'osmode) (list 0 0 1 os))  
)

<<

Filename: 307574_cvp.lsp
Tác giả: ndtnv
Bài viết gốc: 307622
Tên lệnh: n1 n2 l1 l2
Xin lisp lọc chọn các số trong khoảng AB

Bổ sung theo yêu cầu:

(defun c:n1() (SelRange1 <))
(defun c:n2() (SelRange1 <=))
(defun c:l1() (SelRange1 >))
(defun c:l2() (SelRange1 >=))

(defun SelRange1(f / ss a)
    (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT")))) a (getreal "\nNhap so: ") )
    (command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x / v) (if (and (setq v (distof (cdr (assoc 1 (entget x)))))(f v a )) x nil)) ss))) "")
   ...
>>

Bổ sung theo yêu cầu:

(defun c:n1() (SelRange1 <))
(defun c:n2() (SelRange1 <=))
(defun c:l1() (SelRange1 >))
(defun c:l2() (SelRange1 >=))

(defun SelRange1(f / ss a)
    (setq ss  (acet-ss-to-list (ssget '((0 . "TEXT")))) a (getreal "\nNhap so: ") )
    (command "_.PSELECT" (acet-list-to-ss (vl-remove nil (mapcar '(lambda(x / v) (if (and (setq v (distof (cdr (assoc 1 (entget x)))))(f v a )) x nil)) ss))) "")
    (princ)
)

<<

Filename: 307622_n1_n2_l1_l2.lsp
Tác giả: Tot77
Bài viết gốc: 307634
Tên lệnh: dlay
lisp chia viewport trong layout

Vì trg hợp của bạn đặc biệt nên làm thêm cho bạn cái lệnh đổi layer của tất ca viewport sang defpoints, cứ để cái lsp trên như thế.

Bạn dùng lệnh này trước khi dùng lsp chia vp.

 

(defun c:dlay()
  (mapcar '(lambda(x) (vla-put-Layer (vlax-ename->vla-object x) "DEFPOINTS"))
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "X" '((0 . "VIEWPORT")))))))
  (princ)
)

Filename: 307634_dlay.lsp
Tác giả: duy782006
Bài viết gốc: 13385
Tên lệnh: xdu
Pick vào màn hình có nhiều điểm trắng xuất hiện.


Bạn vào win Search xem có tìm thấy file acaddoc.lsp không? Nếu có thì pots nội dung file đó lên tôi giúp cho.

Filename: 13385_xdu.lsp
Tác giả: hoalangphong
Bài viết gốc: 13392
Tên lệnh: xdu
Layout




xin cho hỏi việc tắt , mở khóa khung hình thì thực hiện vào đâu cảm ơn nhiều

Filename: 13392_xdu.lsp
Tác giả: nhoclangbat
Bài viết gốc: 308067
Tên lệnh: loo
lisp ghi kích thước không dùng dim

- E có lsp dùng để ghi kích thước cạnh thửa đất của ông anh trong cty, e đã chỉnh sửa 1 tí cho phù hợp với nhu cầu của mình, nhưng tới khúc cuối e không pit làm sao do khả năng hạn chế ^^, mong a nào ghé wa có thể xem và giúp e 1 tí, e cảm ơn nhiều lắm :)

- lsp cho mình chọn điểm đầu và cuối sau đó ghi ra kích thước cạnh đó giống dim nhưng không dùng dim, e muốn thêm phần tùy chọn sau...

>>

- E có lsp dùng để ghi kích thước cạnh thửa đất của ông anh trong cty, e đã chỉnh sửa 1 tí cho phù hợp với nhu cầu của mình, nhưng tới khúc cuối e không pit làm sao do khả năng hạn chế ^^, mong a nào ghé wa có thể xem và giúp e 1 tí, e cảm ơn nhiều lắm :)

- lsp cho mình chọn điểm đầu và cuối sau đó ghi ra kích thước cạnh đó giống dim nhưng không dùng dim, e muốn thêm phần tùy chọn sau cùng là mình có thể chọn hướng để ghi ra kích thước dù mình pick hướng nào đầu tiên cũng được, e có hình minh họa lsp chạy ^^:

104473_12_1.gif

- còn hình sau đây là phần e mún chỉnh sữa nó sẽ được như thế này :

104473_13_1.gif

- Tiện lun thì a nào nhiệt tình giúp e viết 1 lsp có chức năng tương tự nhưng nhanh hơn bằng cách quét chọn đối tượng gồm line và pline, sau khi chọn enter or click phải chuột sẽ ghi kích thước toàn bộ đt đã chọn ^^, khu đất nhiều cạnh mà pick từng cạnh cũng đuối, mong được các a giúp đỡ

;;;Dung de ghi kich thuoc va mui ten kich thuoc
(defun RTD (a) (* 180 (/ a PI)))
(defun C:loo (/ h k d w x f tl so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 old echo)
(command "layer" "m" "B-Canh1" "c" "7" "" "")
(command "style" "VAVON" "vni-avo" 0 1 0 "" "")
(setq echo (getvar "cmdecho"))
  (setq old (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 1)
  (command ".layer" "s" "B-CANH1" "")
  (setvar "TEXTSTYLE" "VAVON")
  (command "UNDO" "BE" "")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
  ;co so lan: x
  (setq x (/ 1000 tl))
  ;(setq h (/ 1.7 x))
  (while (= (setq h (/ 1.7 x)) 0))
 	(setq d (/ 1.6 x)
		  w (/ 0.48 x)
		  k 2.50
		  f (/ 0.90 x)) ; f là khoang cach mui ten voi canh can do
  (while (and (/= (setq pt1 (getpoint "\nDiem dau: ")) nil)
             (/= (setq pt2 (getpoint "\nDiem cuoi: ")) nil))
    (setvar "OSMODE" 0)
    (setq goc (angle pt1 pt2) so (distance pt1 pt2)
          canh (rtos so 2 2)  goc90 (+ goc (/ PI 2)))
    (setq pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
		  pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
		  pt9 (polar pt3 goc (/ so 2))
		  pt7 (polar pt9 goc90 10)
		  pt8 (polar pt1 goc (/ so 2))
		  pt (polar pt8 goc90 (/ 1.4 x)))
		  
		  
		  
		  
		  
		  
    (if (or (>= so k) (< tl 500))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
        (command "MIRROR" "L" "" pt9 pt7 "")
      );progn
    );if
	    (if (or (<= (RTD goc) 90) (>= (RTD goc) 270)) 
      (command "TEXT" "M" pt h (RTD goc) canh "")
      (command "TEXT" "M" pt h (+ (RTD goc) 180) canh "")
    );if
    (setvar "OSMODE" 1)
  );while
  (command "UNDO" "E" "")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)

 

 

 


<<

Filename: 308067_loo.lsp
Tác giả: Tot77
Bài viết gốc: 308098
Tên lệnh: loo
lisp ghi kích thước không dùng dim

Gửi bạn lsp số 1.

(defun RTD (a) (* 180 (/ a PI)))
(defun C:loo (/ h k d w x f tl so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 old echo)
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VAVON" "vni-avo" 0 1 0 "" "")
  (setq echo (getvar "cmdecho"))
  (setq old (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 1)
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style"...
>>

Gửi bạn lsp số 1.

(defun RTD (a) (* 180 (/ a PI)))
(defun C:loo (/ h k d w x f tl so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 old echo)
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VAVON" "vni-avo" 0 1 0 "" "")
  (setq echo (getvar "cmdecho"))
  (setq old (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 1)
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VAVON")  (setvar "TEXTSTYLE" "VAVON"))
  (command "UNDO" "BE" "")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
  ;co so lan: x
  (setq x (/ 1000 tl))
  ;(setq h (/ 1.7 x))
  (while (= (setq h (/ 1.7 x)) 0))
  (setq d (/ 1.6 x)
 w (/ 0.48 x)
 k 2.50
 f (/ 0.90 x)) ; khoang cach mui ten voi canh can do
  (while (and (/= (setq pt1 (getpoint "\nDiem dau: ")) nil)
             (/= (setq pt2 (getpoint "\nDiem cuoi: ")) nil))
    (setvar "OSMODE" 0)    
    (setq goc (angle pt1 pt2) so (distance pt1 pt2)
          canh (rtos so 2 2)  )
    (setq pt8 (polar pt1 goc (/ so 2))
 pt7 (getpoint pt8 "\nPhia:")
 pt10 (inters pt1 pt2 pt7 (polar pt7 (+ goc (/ PI 2)) 1) nil)
 goc90 (angle pt10 pt7))
    (setq pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
 pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
 pt9 (polar pt3 goc (/ so 2))  
 pt (polar pt8 goc90 (/ 1.4 x)))
    
    
    (if (or (>= so k) (< tl 500))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
        (command "MIRROR" "L" "" pt9 pt8 "")
      );progn
    );if
    (if (or (<= (RTD goc) 90) (>= (RTD goc) 270)) 
      (command "TEXT" "M" pt h (RTD goc) canh "")
      (command "TEXT" "M" pt h (+ (RTD goc) 180) canh "")
    );if
    (setvar "OSMODE" 1)
  );while
  (command "UNDO" "E" "")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)
 

<<

Filename: 308098_loo.lsp
Tác giả: mrphuocvie
Bài viết gốc: 308100
Tên lệnh: d1
Lisp stretch nhóm đối tượng 2 phía vào giữa và xung quanh vào tâm
(defun c:D1()
    (setvar "cmdecho" 0)
	(setvar "clayer" "07寸法")
	(command "dimlinear" pause pause pause)
	(command "dimcontinue" entlast "")
    (princ)
)

Tại sao mình không chuyển sang .vlx được.

Nó báo lỗi:

; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"

 

; Compilation aborted
; error: compiler found fatal error...
>>
(defun c:D1()
    (setvar "cmdecho" 0)
	(setvar "clayer" "07寸法")
	(command "dimlinear" pause pause pause)
	(command "dimcontinue" entlast "")
    (princ)
)

Tại sao mình không chuyển sang .vlx được.

Nó báo lỗi:

; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"

 

; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"
; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"
; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"
; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"
; Compilation aborted
; error: compiler found fatal error "Setlayerdim-140819.lsp"

<<

Filename: 308100_d1.lsp
Tác giả: Tot77
Bài viết gốc: 308120
Tên lệnh: loi
lisp ghi kích thước không dùng dim

Gửi bạn lsp số 2. Cái này chỉ quét các đt mà không cần chọn phía.

Phần tỷ lệ tôi không đổi gì cả. Nếu gặp trục trặc chỗ nào thì bạn gửi file dwg lên.

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so...
>>

Gửi bạn lsp số 2. Cái này chỉ quét các đt mà không cần chọn phía.

Phần tỷ lệ tôi không đổi gì cả. Nếu gặp trục trặc chỗ nào thì bạn gửi file dwg lên.

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so (distance pt1 pt2)
          canh (rtos so 2 2))
    (setq pt8 (polar pt1 goc (/ so 2))    
 goc90 (+ goc (* 0.5 pi)) 
          pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
 pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
 pt9 (polar pt3 goc (/ so 2))  
 pt (polar pt8 goc90 (/ 1.4 x)))    
    
    (if (or (>= so k) (< tl 500))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
        (command "MIRROR" "L" "" pt9 pt8 "")
      );progn
    );if
    (if (or (<= (RTD goc) 90) (>= (RTD goc) 270)) 
      (command "TEXT" "M" pt h (RTD goc) canh "")
      (command "TEXT" "M" pt h (+ (RTD goc) 180) canh "")
    );if
  )
  
  (defun getp(v / l1)
    (if (= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
      (setq l1 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v)))
   l1 (if (or (= 1 (cdr (assoc 70 (entget v))))
      (equal (car l1) (last l1) 0.001))
(mapcar 'list l1 (append (cdr l1) (list (car l1))))
(mapcar 'list l1 (cdr l1) )))
    )
    (mapcar '(lambda(y) (ve (car y) (last y))) l1)
  )
  
  ;;;
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VAVON" "vni-avo" 0 1 0 "" "")
  (setq echo (getvar "cmdecho"))
  (setq old (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (setvar "OSMODE" 1)
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VAVON")  (setvar "TEXTSTYLE" "VAVON"))
  (command "UNDO" "BE" "")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
  ;co so lan: x
  (setq x (/ 1000 tl))
  (while (= (setq h (/ 1.7 x)) 0))
  (setq d (/ 1.6 x)
        w (/ 0.48 x)
        k 2.50
        f (/ 0.90 x)) ; khoang cach mui ten voi canh can do
    
  (mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
   
  (command "UNDO" "E" "")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)

<<

Filename: 308120_loi.lsp
Tác giả: Tot77
Bài viết gốc: 308238
Tên lệnh: loi
lisp ghi kích thước không dùng dim

Đó là do cái dòng 

 

(if (or (>= so k) (< tl 500))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
        (command "MIRROR" "L" "" pt9 pt8 "")
      );progn

Ý nói nếu kc 2 điểm >=2.5 hoặc tl < 500  thì nó mới vẽ mũi tên.

Phần tỷ lệ này tôi đã nói là không đổi sửa gì cả, cứ theo cái lsp gốc thôi.

Bạn chép...

>>

Đó là do cái dòng 

 

(if (or (>= so k) (< tl 500))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
        (command "MIRROR" "L" "" pt9 pt8 "")
      );progn

Ý nói nếu kc 2 điểm >=2.5 hoặc tl < 500  thì nó mới vẽ mũi tên.

Phần tỷ lệ này tôi đã nói là không đổi sửa gì cả, cứ theo cái lsp gốc thôi.

Bạn chép lại lsp 2 tôi xoá cái osmode do bắt điểm endpoint của lsp gốc, và nó sẽ vẽ nới mọi kc, chỉ có điều ko biết chiều cao chữ có ok ko thôi.

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so (distance pt1 pt2)
          canh (rtos so 2 2))
    (setq pt8 (polar pt1 goc (/ so 2))    
 goc90 (+ goc (* 0.5 pi)) 
          pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
 pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
 pt9 (polar pt3 goc (/ so 2))  
 pt (polar pt8 goc90 (/ 1.4 x)))    
    
    (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
    (command "MIRROR" "L" "" pt9 pt8 "")
    (command "TEXT" "M" pt h (RTD goc) canh "")
  )
  
  (defun getp(v / l1)
    (if (= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
      (setq l1 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v)))
   l1 (if (or (= 1 (cdr (assoc 70 (entget v))))
      (equal (car l1) (last l1) 0.001))
(mapcar 'list l1 (append (cdr l1) (list (car l1))))
(mapcar 'list l1 (cdr l1) )))
    )
    (mapcar '(lambda(y) (ve (car y) (last y))) l1)
  )
  
  ;;;
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VAVON" "vni-avo" 0 1 0 "" "")
  (setq echo (getvar "cmdecho"))
  (setq old (getvar "OSMODE"))
  (setvar "cmdecho" 0)
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VAVON")  (setvar "TEXTSTYLE" "VAVON"))
  (command "UNDO" "BE")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
 
  (setq x (/ 1000 tl)
h (/ 1.7 x)
d (/ 1.6 x)
        w (/ 0.48 x)
        f (/ 0.90 x)) 
    
  (mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
   
  (command "UNDO" "E")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)

<<

Filename: 308238_loi.lsp
Tác giả: Tot77
Bài viết gốc: 308245
Tên lệnh: loi
lisp ghi kích thước không dùng dim

Bạn chép lại lsp 2, có thể vẽ text và mũi tên với mọi khoảng cách.

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so (distance pt1 pt2)
          canh (rtos so 2 2))
    (setq pt8 (polar pt1 goc (/ so 2))    
 goc90 (+ goc (* 0.5...
>>

Bạn chép lại lsp 2, có thể vẽ text và mũi tên với mọi khoảng cách.

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so (distance pt1 pt2)
          canh (rtos so 2 2))
    (setq pt8 (polar pt1 goc (/ so 2))    
 goc90 (+ goc (* 0.5 pi)) 
          pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
 pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
 pt9 (polar pt3 goc (/ so 2))  
 pt (polar pt8 goc90 (/ 1.4 x)))    
    
    (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
    (command "MIRROR" "L" "" pt9 pt8 "")
    (command "TEXT" "M" pt h (RTD goc) canh "")
  )
  
  (defun getp(v / l1)
    (if (= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
      (setq l1 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v)))
   l1 (if (or (= 1 (cdr (assoc 70 (entget v))))
      (equal (car l1) (last l1) 0.001))
(mapcar 'list l1 (append (cdr l1) (list (car l1))))
(mapcar 'list l1 (cdr l1) )))
    )
    (mapcar '(lambda(y) (ve (car y) (last y))) l1)
  )
  
  ;;;
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VAVON" "vni-avo" 0 1 0 "" "")
  (setq echo (getvar "cmdecho")) (setvar "cmdecho" 0)
  (setq old (getvar "OSMODE")) (setvar 'osmode 0)   
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VAVON")  (setvar "TEXTSTYLE" "VAVON"))
  (command "UNDO" "BE")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
 
  (setq x (/ 1000 tl)
h (/ 1.7 x)
d (/ 1.6 x)
        w (/ 0.48 x)
        f (/ 0.90 x)) 
    
  (mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
   
  (command "UNDO" "E")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)

Còn vụ text nằm ngoài khu đất thì chỉ có thể làm với pline thôi chứ line thì khó (hoặc phải pick điểm).

Nhưng với 2 khu đất tiếp giáp nhau thì sao, bạn phải tính đến chuyện đó.


<<

Filename: 308245_loi.lsp
Tác giả: Tot77
Bài viết gốc: 308276
Tên lệnh: loi
lisp ghi kích thước không dùng dim

Bạn thử cái này, có thêm lựa chọn có vẽ mũi tên hay không. Nếu kc nhỏ quá nó sẽ ko vẽ mũi tên.

 

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt0 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so (distance pt1 pt2)
          canh (rtos so 2 2))
    (setq pt8 (polar...
>>

Bạn thử cái này, có thêm lựa chọn có vẽ mũi tên hay không. Nếu kc nhỏ quá nó sẽ ko vẽ mũi tên.

 

(defun c:loi(/ tl w k h echo old x d f)
  (defun ve(pt1 pt2 / goc so canh pt8 goc90 pt3 pt4 pt5 pt6 pt9 pt0 pt) ;;; tl w k h f x d
    (if (> (car pt1) (car pt2)) (setq pt0 pt1 pt1 pt2 pt2 pt0))
    (setq goc (angle pt1 pt2)
 so (distance pt1 pt2)
          canh (rtos so 2 2))
    (setq pt8 (polar pt1 goc (/ so 2))    
 goc90 (+ goc (* 0.5 pi)) 
          pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
 pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
 pt9 (polar pt3 goc (/ so 2))  
 pt (polar pt8 goc90 (/ 1.4 x)))    
    (if (and cove (> so (* 4 (distance pt3 pt6))))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
        (command "MIRROR" "L" "" pt9 pt8 ""))
    )
    (command "TEXT" "M" pt h (RTD goc) canh "")
  )
  
  (defun getp(v / l1)
    (if (= "LINE" (cdr (assoc 0 (entget v))))
      (setq l1 (list (list (cdr (assoc 10 (entget v))) (cdr (assoc 11 (entget v))))))
      (setq l1 (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= (car x) 10)) (entget v)))
   l1 (if (or (= 1 (cdr (assoc 70 (entget v))))
      (equal (car l1) (last l1) 0.001))
(mapcar 'list l1 (append (cdr l1) (list (car l1))))
(mapcar 'list l1 (cdr l1) )))
    )
    (mapcar '(lambda(y) (ve (car y) (last y))) l1)
  )
  
  ;;;
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VAVON" "vni-avo" 0 1 0 "" "")
  (setq echo (getvar "cmdecho")) (setvar "cmdecho" 0)
  (setq old (getvar "OSMODE")) (setvar 'osmode 0)   
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VAVON")  (setvar "TEXTSTYLE" "VAVON"))
  (command "UNDO" "BE")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
  (initget "Y N")
  (setq cove (getkword "\nVe mui ten <Enter=Yes/No>: "))
  (if (= cove "N") (setq cove nil) (setq cove t))
  
  (setq x (/ 1000 tl)
h (/ 1.7 x)
d (/ 1.6 x)
        w (/ 0.48 x)
        f (/ 0.90 x)) 
    
  (mapcar 'getp (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "LINE,LWPOLYLINE")))))))
   
  (command "UNDO" "E")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)

<<

Filename: 308276_loi.lsp
Tác giả: nhoclangbat
Bài viết gốc: 308299
Tên lệnh: lkk
lisp ghi kích thước không dùng dim

- anh Tot77 ơi lsp2 #19 chạy tốt lắm ^^, thanks a

- tối qua e có ngồi mò cách để đặt điều kiện cho lsp1 ra mũi tên hay không, sau khi mò e thử làm đại, sau đó thử vài trường hợp thấy cũng ok lắm, nhưng e không pit nó bị lỗi gì chỉ pick đc đúng 2 lần tự thoát lệnh ko lặp lại đc @@ "error: bad argument type: 2D/3D point: nil"

- anh xem giúp e hen ^^

>>

- anh Tot77 ơi lsp2 #19 chạy tốt lắm ^^, thanks a

- tối qua e có ngồi mò cách để đặt điều kiện cho lsp1 ra mũi tên hay không, sau khi mò e thử làm đại, sau đó thử vài trường hợp thấy cũng ok lắm, nhưng e không pit nó bị lỗi gì chỉ pick đc đúng 2 lần tự thoát lệnh ko lặp lại đc @@ "error: bad argument type: 2D/3D point: nil"

- anh xem giúp e hen ^^

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/108679-nho-chinh-sua-lisp-ghi-kich-thuoc-khong-dung-dim/
(defun RTD (a) (* 180 (/ a PI)))
(defun C:lkk (/ h k d w x f tl so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 text noidung diem hieu old echo)
  (setq echo (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VHELVCN" "vni-Helve-Condense" 0 1 0 "" "")
  (setq old (getvar "OSMODE"))
  (setvar "OSMODE" 1)
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VHELVCN")  (setvar "TEXTSTYLE" "VHELVCN"))
  (command "UNDO" "BE" "")
  (setq tl (getreal "\n don vi ban do ht 1/ <1000>: "))
  (if (= tl nil) (setq tl 1000))
  ;co so lan: x
  (setq x (/ 1000 tl))
  ;(setq h (/ 1.7 x))
  (while (= (setq h (/ 1.7 x)) 0))
  (setq d (/ 1.6 x)
 w (/ 0.48 x)
 k 2.50
 f (/ 0.90 x)) ; khoang cach mui ten voi canh can do
  (while (and (/= (setq pt1 (getpoint "\nDiem dau: ")) nil)
             (/= (setq pt2 (getpoint pt1 "\nDiem cuoi: ")) nil))
    (setvar "OSMODE" 0)    
    (setq goc (angle pt1 pt2) so (distance pt1 pt2)
          canh (rtos so 2 2)  )
    (setq pt8 (polar pt1 goc (/ so 2))
          pt7 (getpoint pt8 "\nPhia:")
          pt10 (inters pt1 pt2 pt7 (polar pt7 (+ goc (/ PI 2)) 1) nil)
          goc90 (angle pt10 pt7))
    (setq pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
           pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
          pt9 (polar pt3 goc (/ so 2))  
           pt (polar pt8 goc90 (/ 1.4 x))
          pt11 (polar pt6 goc (- so (* 4 d)))
          pt14 (polar pt11 goc d))
		  
    (if (or (<= (RTD goc) 90) (>= (RTD goc) 270)) 
      (command "TEXT" "M" pt h (RTD goc) canh "")
      (command "TEXT" "M" pt h (+ (RTD goc) 180) canh "")
    );if
	(setq text (entlast)
		  noidung (entget text)
		  diem (cdr (assoc 10 noidung)))
    (setq pt12 (inters pt3 pt4 diem (polar diem goc90 20))
		  pt13 (polar pt12 goc (* 2  (distance pt12 pt9)))
		  )
	(setq hieu (- (distance pt6 pt11) (distance pt12 pt13))) 
    (if (>= hieu 0)
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
	    (command "PLINE" pt11 "W" 0.0 0.0 pt14 "W" w 0.0 pt4 "")
        ;(command "MIRROR" "L" "" pt9 pt8 "")
      );progn
    );if
    
    (setvar "OSMODE" 1)
  );while
  (command "UNDO" "E" "")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)
 

- anh có thể gợi ý cách cho lsp1 nhớ biến tỉ lệ lần nhập đầu tiên ko a :), vd: minh nhap 1/200 sau khi thoat goi lenh lại nó van hiện 1/200 enter tip tục, con ko thì nhap tỉ lệ khác


<<

Filename: 308299_lkk.lsp
Tác giả: nhoclangbat
Bài viết gốc: 308346
Tên lệnh: lkk
lisp ghi kích thước không dùng dim
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/108679-nho-chinh-sua-lisp-ghi-kich-thuoc-khong-dung-dim/
(defun RTD (a) (* 180 (/ a PI)))
(defun C:lkk (/ h k d w x f  so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 text noidung diem hieu old echo)
  (setq echo (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VHELVCN"...
>>
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/108679-nho-chinh-sua-lisp-ghi-kich-thuoc-khong-dung-dim/
(defun RTD (a) (* 180 (/ a PI)))
(defun C:lkk (/ h k d w x f  so canh goc goc90 pt pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 text noidung diem hieu old echo)
  (setq echo (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "layer" "m" "B-Canh1" "c" "7" "" "")
  (command "style" "VHELVCN" "vni-Helve-Condense" 0 1 0 "" "")
  (setq old (getvar "OSMODE"))
  (setvar "OSMODE" 33)
  (command ".layer" "s" "B-CANH1" "")
  (if (tblsearch "style" "VHELVCN")  (setvar "TEXTSTYLE" "VHELVCN"))
  (command "UNDO" "BE" "")
  (setq tl (getint "\n don vi ban do ht (500): "))
  (if (= tl nil) (setq tl 500))
   (setq tl1 (getint (strcat "\n don vi ban do ht (" (rtos tl 2 0) "): ")))
   (if tl1 (setq tl tl1))
  ;co so lan: x
  (setq x (/ 1000 tl))
  ;(setq h (/ 1.7 x))
  (while (= (setq h (/ 1.7 x)) 0))
  (setq d (/ 1.6 x)
 w (/ 0.48 x)
 k 2.50
 f (/ 0.90 x)) ; khoang cach mui ten voi canh can do
  (while (and (/= (setq pt1 (getpoint "\nDiem dau: ")) nil)
             (/= (setq pt2 (getpoint pt1 "\nDiem cuoi: ")) nil))
    (setvar "OSMODE" 0)    
    (setq goc (angle pt1 pt2) so (distance pt1 pt2)
          canh (rtos so 2 2)  )
    (setq pt8 (polar pt1 goc (/ so 2))
          pt7 (getpoint pt8 "\nPhia:")
          pt10 (inters pt1 pt2 pt7 (polar pt7 (+ goc (/ PI 2)) 1) nil)
          goc90 (angle pt10 pt7))
    (setq pt3 (polar pt1 goc90 f) 
          pt4 (polar pt2 goc90 f)
           pt5 (polar pt3 goc d)
          pt6 (polar pt5 goc d)
          pt9 (polar pt3 goc (/ so 2))  
           pt (polar pt8 goc90 (/ 1.4 x))
          pt11 (polar pt6 goc (- so (* 4 d)))
          pt14 (polar pt11 goc d))
		  
    (if (or (<= (RTD goc) 90) (>= (RTD goc) 270)) 
      (command "TEXT" "M" pt h (RTD goc) canh "")
      (command "TEXT" "M" pt h (+ (RTD goc) 180) canh "")
    );if
	(setq text (entlast)
		  noidung (entget text)
		  diem (cdr (assoc 10 noidung)))
    (setq pt12 (inters pt3 pt4 diem (polar diem goc90 20) nil)
		  pt13 (polar pt12 goc (* 2  (distance pt12 pt9)))
		  )
	(setq hieu (- (distance pt6 pt11) (distance pt12 pt13))) 
    (if (>= hieu (- 0 0.01))
      (progn
        (command "PLINE" pt3 "W" 0.0 w pt5 "W" 0.0 0.0 pt6 "")
	    (command "PLINE" pt11 "W" 0.0 0.0 pt14 "W" w 0.0 pt4 "")
        ;(command "MIRROR" "L" "" pt9 pt8 "")
      );progn
    );if
    
    (setvar "OSMODE" 33)
  );while
  (command "UNDO" "E" "")
  (setvar "OSMODE" old)
  (setvar "cmdecho" echo)
)
 

- a xem giúp e ^^


<<

Filename: 308346_lkk.lsp

Trang 168/304

168