[Nhờ chỉnh sửa] lisp ghi kích thước không dùng dim

[nhoclangbat 392]

- 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 ^^:

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

- 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)
)

 

 

 

[genius111 2]

không hiểu sao mình dùng thử lisp của bạn thì cad lại báo lỗi này cơ: error: AutoCAD variable setting rejected: "TEXTSTYLE" "VAVON"

[Tot77 508]

không hiểu sao mình dùng thử lisp của bạn thì cad lại báo lỗi này cơ: error: AutoCAD variable setting rejected: "TEXTSTYLE" "VAVON"

Vì máy bạn không có font đó.

[nhoclangbat 392]

anh Tot77 giúp nhoc được không a :)

[Tot77 508]

Nếu giúp thì tôi sẽ gộp 2 cái lisp thành 1,

1. chọn 1 hoặc nhiều đối tượng.

2. Chọn phía đặt dim và text

3. Ghi dim và text.

Như vậy thì sẽ không pick 2 điểm để lấy khoảng cách mà chỉ cần chọn đối tượng và phía đặt text thôi.

Nhưng nếu chọn nhiều đt 1 lúc thì khi pick phía đặt text có khi hợp với line này nhưng lại không hợp với line khác.

[nhoclangbat 392]

-thanks a đã có ý giúp e ^^

- e nghĩ nên làm 2 lệnh riêng biệt, vì theo kiểu chọn đối với 1 thửa đất đơn giản cạnh thẳng có nét kiến trúc đụng cạnh ranh chẳng hạn thì lsp sẽ không nhận đc điểm mà nét kiến trúc đụng cạnh ranh mà chạy thẳng hết theo cạnh ranh đất,trừ khi e break cạnh ranh đất với điểm mút nét kt đụng ranh đất thì đc như vậy khi chạy tọa độ sẽ tạo ra nhiều điểm ko cần thiết ^^

- lsp thứ 2 e để dành cho những khu lớn có nhiều cạnh hay nhiều khu có vị trí khác nhau thì tiện :)) 

- còn việc phía đặt text để mai e rãnh làm mẫu 1 cái cho a xem, cơ quan có chương trình làm đc mà  xài nội bộ ko cho pass cài nên e ko đem về nhà xài đc :)), thêm nữa mí ổng việt gộp thành file .vlx nên bó tay ^^

[nhoclangbat 392]

-chào ngày mới, e xin đưa 1 số hình minh họa cho các ý của e ở trên e ko giỏi phần diễn đạt lắm ^^

-lý do không nên gộp chung 2 lệnh lại :

- còn đây là ý anh Tot77 làm sao để xác định hướng ghi kích thước khi dùng theo kiểu chọn đối tượng, a xem giúp e, e cũng chưa nắm đc quy luật của nó ^^

- đúng là cơ quan có rùi nhưng ý nguyện e mún 2 lsp riêng biệt đi đau xài cũng đc cho tiện, chư xin pass rùi cài nguyên chương trình cũng ngại ^^

- a Tot77 để ý giúp e, phần định tỷ lệ nha, nó là cái quyết định cao text và kich thước mũi tên cũng như khoảng cách gióng ra với đường cần ghi, quy định chung cho cách thể hiện ở chỗ e lấy 1/1000 làm cơ sở ban đầu từ đó suy ra cho các tỉ lệ khác, lsp mà em đưa lên em đã chỉnh cho đúng cách thể hiện đó a :)

- còn 1 chút xíu e đang học mà chưa tới hàm if nên nắm ko đc rõ lắm sơ sơ nên ko pit đặt đk thế nào cho đúng chỗ quyết định có vẽ mũi tên hay ko dựa theo tỉ lệ hiện trạng và kích thước, đk kiện e mún là đối với cạnh ngắn e lấy chuẫn là < 2.50, thì nếu tỉ lệ nhỏ 500 - 1000 -> 2000 => text sẽ lớn thì sẽ ko vẽ mũi tên, còn nếu cũng với cạnh ngắn đó mà tỉ lệ nhỏ 500 trở lên, bên e tối đa là 200 thui thì text nhỏ thì vẫn vẽ mủi tên,sao cho text với đuôi mũi tên ko trùng lên nhau ^^

- mong đc các anh giúp đỡ :)

[Tot77 508]

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)
)
 

[Tot77 508]

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)
)

[ketxu 2.984]

Đáng ra cái lisp 1 này nhocangbat phải tự viết được rồi mới phải.. Hzzz

[Tot77 508]

Bác Ket cũng đừng nên la học sinh của mình, vì nhiều khi họ không nghĩ ra cái thuật toán chứ không phải không biết cách viết lisp.

[ketxu 2.984]

Hi ^^ nhoclangbat có năng khiếu lắm, n chắc vẫn còn chưa đủ chăm thôi. Thấy mày mò ghê lắm. Chắc chắn nếu cố là sẽ được :)
@nhoclangbat : sao ở công ty lại có ý định vẽ cái mũi tên bằng Pline nhỉ, hơi khó hiểu. Sau này nhỡ chỉnh thì làm sao. Cá nhân ket trong trường hợp này sẽ dùng Leader hoặc Block.
- Hàm if chưa học nhưng cú pháp nó cũng chỉ như thế này thôi :

(if  (điều kiện)
    (progn
          (các biểu thức nếu (điều kiện) khác nil)
   )
   (progn 
         (các biểu thức nếu (điều kiện) nil)
  )
)

[nhoclangbat 392]

^^ lsp này nhoc cũng định tự mò hồi đó rui mà bận đi làm a nuôi 1 time quên sạch, nhoc cũng ko nhớ hàm polar có côg dụng j :), mơi đây mò cái lsp này nhoc mới nhớ lại, nhiều hàm wa mà ko nhớ nổi côg dụng từng hàm lúc nào làm cũng phải lật ra xem ^^, lệnh cad nhoc cung phai thu trong cad truoc xem cac buoc cua no chứ ko nhớ nổi

- thanks a Tot77 nhiều đã giúp nhoc, để chiều vè nhoc thử lsp 2 nhoc đag đi thực địa :)

[nhoclangbat 392]

từ khi đi làm thì nhoc đã thấy dùng mũi tên = pline nhoc cũng ko pit tại sao, mà ý anh Ket chỉnh sửa ở đây là chỉnh gì,nhoc chỉ pit nếu có pick sai hai nhầm thì xóa hết pick lại :)

[nhoclangbat 392]

hihi lsp 2 bị lỗi gì a Tot77 ơi, dòng command nó báo "Points must be distinct." ko ra kích thước lun, lúc đầu load thì ra dim nhưng lại ko ra đc ngay giữa cạnh mà đầu cạnh, tắt cad khơi động lại load lại chạy lại lỗi như chữ đỏ ko ra gì hết ^^

[nhoclangbat 392]

Đó 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 là muốn sửa thế nào.

- Hi cái này e có nhờ a xem thử ở trên e có nêu, e cũng ko pit đặt đk thế nào cho hợp lý ^^, e suy nghĩ là mình có thể đặt đk dựa vào thông số khoảng cách giữa 2 đuôi mũi tẹn và chiều dài text sao cho khoảng cách giữa 2  đuôi mũi tên lớn hơn text và khi text đặt giữa sẽ có 1 khoảng trống tương đối  với 2 đuôi mũi tên sẽ dể nhìn khi in ra miễn nó không bị chồng lên nhau, e có làm thử khoảng cách cở 0.25 là đẹp, dùng cơ số tỉ lệ cũng khó :).

- thêm 1 xí là a có thể sữa thêm lsp 2 phần phía đặt text  , vd 1 khu dat khép kín chẳng hạn thì toàn bộ text sẽ nằm đường bao ngoài ko bị lọt vào trong, tùy trường hợp e sữa tay lại cũng đc :), cho thêm phần lựa chọn cuối cùng có vẽ mũi tên ko mặc định là yes, như khu phân lô dài chẳng hạn đc chia đều mình chỉ cần lên kick thước nhìn là hiểu ko cần ghi mũi tên nhìn sẽ rối ^^.

- a thông cảm e yêu cầu hơi nhiều !!!

[Tot77 508]

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 đó.

[nhoclangbat 392]

- anh Tot77 chỉnh giúp e cái đk vẽ mũi tên đc không a ^^, em thử kc 2.5 mà tỉ lệ 1/1000 nó ra mủi tên chồng lên text lun :))

[Tot77 508]

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)
)

[nhoclangbat 392]

- 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

[phamhuy1 8]

ketxu

 

Gửi vào Hôm qua, 09:25 AM

Đáng ra cái lisp 1 này nhocangbat phải tự viết được rồi mới phải.. Hzzz

Mình nghĩ lisp 1 nhoclangbat nên tự bơi... đừng phụ lòng người dạy lisp cho mình :angry2:

[Tot77 508]

1. Bạn chỉ làm dc 1 lần là vì lần sau nó không tìm thấy giao điểm (tức là điểm pt12), bạn phải cho nó extend 2 đoạn thẳng = cách viết :

(setq pt12 (inters pt3 pt4 diem (polar diem goc90 20) nil))

 

2. Bạn có thể lưu biến tl = 2 động tác sau:

 a. Không khử biến tl khi khai báo defun.

 b. Viết lại đoạn tỉ lệ như sau:

    (if (= tl nil) (setq tl 1000))

    (setq tl1 (getreal (strcat "\n don vi ban do ht 1/ <" (rtos tl) ">: ")))

    (if tl1 (setq tl tl1))

[nhoclangbat 392]

thanhk a Tot77 để e thử :)

[nhoclangbat 392]

Mình nghĩ lisp 1 nhoclangbat nên tự bơi... đừng phụ lòng người dạy lisp cho mình :angry2:

^^

 

[nhoclangbat 392]

- nó trục trặc sao đó e chưa hiểu a Tot77 ơi ^^

don vi ban do ht (500): 200
 don vi ban do ht (200):
Diem dau:
Diem cuoi:
Phia:Unknown command "LKK".  Press F1 for help.

Diem dau:
Unknown command "LKK".  Press F1 for help.
1

Command:  LKK
Unknown command "LKK".  Press F1 for help.

 don vi ban do ht (500):

 don vi ban do ht (500):

- e chỉ mún nó hiện 1 lần hỏi tỉ lệ thui, set them tl1 nên nó hỏi tip, mặc đinh là 500 e nhập 200, sau khi e dim xong e kết thúc lệnh, sau đó gọi lại nó ko nhớ là 200 vẫn cứ 500 @@, e đã ko khử biến tl ở dòng khai báo dèun rùi :)