Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
nhoclangbat

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

Các bài được khuyến nghị

nhoclangbat    382

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

 

 

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

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

yL5RcI.gif

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

zCfTok.gif

- đú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 đỡ :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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)
)
 
  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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)
)
  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
ketxu    2.649

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)
  )
)
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

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

Qe2WxH.gif

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

Đó 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 !!!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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)
)
  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

- 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

  • Vote giảm 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamhuy1    3

 

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:

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tot77    501

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
nhoclangbat    382

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×