Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
nhoclangbat

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

Bởi nhoclangbat , trong AutoLisp

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

nhoclangbat    392

nhoclangbat
Đã đăng 
;; 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 ^^

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    508

Tot77
Đã đăng

1. Bạn xoá cái dòng (setq tl (getint "\n don vi ban do ht (500): "))

2. Sửa lại (command "PLINE" pt4 "W" 0.0 w pt14 "W" 0.0 0.0 pt11 "")

3. (command "TEXT" "M" pt h (RTD goc) canh )

    (command "TEXT" "M" pt h (+ (RTD goc) 180) canh )  xoá dấu "" ở cuối.

  • 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    392

nhoclangbat
Đã đăng

-Hihi thanks a Tot77, 2 lsp giờ chạy tốt rùi a, e còn lăn tăn 1 xíu với lsp2 có cách code nào cho cad nó chạy nhẹ hơn không a nhỉ, e thử dim với 1 loc dạng phân lô có nhiều lô nhỏ thì nhìn cad chạy có vẽ mệt hơi chậm ^^ chưa đc gọn như chương trình ở cơ quan, em cũng ko dám đòi hỏi thêm, e thấy vậy tạm đủ xài, khi nào tay nghề lên sữa sau cũng đc :), minh họa tí cho zui

scStk8.gif

- của cơ quan nhanh hơn tí :)

WndP7Y.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

Tot77    508

Tot77
Đã đăng

Thì ng ta đầu tư nhiều thời gian công sức hơn dĩ nhiên phải tốt hơn, nếu không họ compile thành vlx làm gì?

Cái này để khi nào bạn học tới hàm entmake thì bạn thay tất cả các dòng nào có command thành entmake, nó sẽ tăng tốc cho ct khá nhiều.

  • 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

tientracdia    16

tientracdia
Đã đăng

1. Bạn xoá cái dòng (setq tl (getint "\n don vi ban do ht (500): "))

2. Sửa lại (command "PLINE" pt4 "W" 0.0 w pt14 "W" 0.0 0.0 pt11 "")

3. (command "TEXT" "M" pt h (RTD goc) canh )

    (command "TEXT" "M" pt h (+ (RTD goc) 180) canh )  xoá dấu "" ở cuối.

;; 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/page-2
;; 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)
)
 

Con phần này sửa ở đâu, mong bạn giữp

2. Sửa lại (command "PLINE" pt4 "W" 0.0 w pt14 "W" 0.0 0.0 pt11 "")

3. (command "TEXT" "M" pt h (RTD goc) canh )

    (command "TEXT" "M" pt h (+ (RTD goc) 180) canh )  xoá dấu "" ở cuố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

Tot77    508

Tot77
Đã đăng

Bạn tìm chỗ nào có (command "TEXT" ...) và  (command "PLINE" ...) (cái "PLINE" cuối cùng)

Hay bạn nhoc post cái lsp1 cuối cùng lên cho ai muốn down.

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

hieuhx68    1

hieuhx68
Đã đăng

 

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

Mọi người giúp thêm em yêu cầu này nữa được ko ạ. Lênh trên đã rất oke khi đo hàng loạt kích thước rồi ạ. Em muốn mọi người giúp thêm là cho em nó gắn vào 1 loại dim hiện tại để đo. ( tức là ko hiện mũi tên hay ko có mũi tên mà nó sẽ được quy định theo dim hiện tại mình đặt). Em xin cảm ơ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

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×