Đến nội dung


Hình ảnh
- - - - -

[Nhờ chỉnh sửa] Lisp tính cao độ


  • Please log in to reply
20 replies to this topic

#1 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 July 2013 - 10:42 AM

-------------------------Tim cao do----------chuan f2-----------------------------
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=61449&hl=&fromsearch=1

(defun C:f2( / ss L te p1 p2 textmau P)
(initget "P")
(setq cdd (getreal "\nNhap cao do dau hoac go P de chon Text cao do dau :"))
(if (= cdd "P")
(setq cdd (atof (cdr(assoc 1 (entget(car(entsel "\n Pick chon Text cao do dau :")))))))
)

(setq p1 (getpoint "\n Chon diem da biet cao do:"))

(while (setq p2 (getpoint p1 "\n Chon diem can tim cao do :"))
(setq L (+ cdd (- (cadr p2) (cadr p1))))

(initget "T")
(setq p (getpoint "\nPick diem chen Text hoac go T de chon Text :"))

(if (/= p "T")
(progn
(if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau))
(cons 10 p) (cons 11 p) (assoc 7 (entget textmau))
(assoc 8 (entget textmau))
))
)
(progn
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
);while
(princ)
)

Mô tả Lisp trên 
- Gõ lệnh f2
- Có 2 lựa chon : Nhap cao do dau hoac go P de chon Text cao do dau (1)
Sau đó lisp tính ra cao độ điểm cần tìm qua 1 trong 2 lựa chọn
- Pick diem chen Text hoac go T de chon Text (2)
Nhờ các member giúp em ở bước (1) (2) làm sao cho lisp đưa ra lựa chọn pick điểm luôn,
Ở (1)  bỏ đi lựa chọn: Nhap cao do dau 
(2) bỏ đi lựa chọn  Pick diem chen Text
 


  • 0

#2 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 July 2013 - 10:48 AM

------------------------do khoang cach giua 2 diem va ghi ra text ------ghi ra text------cach 2---------

------------------------do khoang cach giua 2 diem va ghi ra text ------ghi ra text------cach 2---------
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=61450&pid=187391&st=0&#entry187391


(defun C:4( / ss L te p1 p2 textmau P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))

(if (/= p "T")
(progn
(if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
(entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau))
(cons 10 p) (cons 11 p) (assoc 7 (entget textmau))
))
)
(progn
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)
)
)
)

 

Đây là lisp đo khoảng cách. Các bác sửa giúp em như trên với :

Ở bước : Pick diem chen hoac go T de chon Text , giúp em bỏ đi lựa chọn Pick điểm chèn, em muốn Chọn Text để gán kết quả luôn

Thank !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...=0
 
 
(defun C:4( / ss L te p1 p2 textmau P)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :")) 
(setq p2 (getpoint p1 "\n Chon diem thu hai :"))
)
(setq L (distance p1 p2))
(initget "T")
(setq p (getpoint "\nPick diem chen hoac go T de chon Text :"))
 
(if (/= p "T")
  (progn 
    (if (not textmau) (setq textmau (car(entsel "\nChon Text mau:"))))
    (entmake (list (cons 0 "TEXT") (cons 1 (rtos L 2 2)) (assoc 40 (entget textmau)) 
  (cons 10 p) (cons 11 p) (assoc 7 (entget textmau)) 
    ))
  )
  (progn
  (setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
  )
)
)
)

  • 0

#3 TaiNguyen79

TaiNguyen79

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 24 (tàm tạm)

Đã gửi 27 July 2013 - 11:42 AM

Sửa cho bạn đây :

(defun C:f2( / cdd L te p1 p2)
(setq cdd (atof (cdr(assoc 1 (entget(car(entsel "\n Pick chon Text cao do dau :")))))))
(setq p1 (getpoint "\n Chon diem da biet cao do:"))
(while (setq p2 (getpoint p1 "\n Chon diem can tim cao do :"))
(setq L (+ cdd (- (cadr p2) (cadr p1))))
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te))(princ))
;---
(defun C:4( / L te p1 p2)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))(setq p2 (getpoint p1 "\n Chon diem thu hai :")))
(setq L (distance p1 p2))
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :"))) te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te))(princ))


  • 2

#4 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 July 2013 - 02:02 PM

ok. thankyou đồng chí nhìu na.


  • 0

#5 vuloixd

vuloixd

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 07 September 2013 - 04:07 PM

Mình cũng đang dùng lisp tương tự như trên nhưng mình muốn sau khi thay điểm thứ nhất thì chọn tiếp điểm tiếp theo mà không dùng thêm lệnh nữa.


  • 0

#6 namtrantt206xd

namtrantt206xd

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 05 June 2014 - 11:04 AM

Sửa cho bạn đây :


(defun C:f2( / cdd L te p1 p2)
(setq cdd (atof (cdr(assoc 1 (entget(car(entsel "\n Pick chon Text cao do dau :")))))))
(setq p1 (getpoint "\n Chon diem da biet cao do:"))
(while (setq p2 (getpoint p1 "\n Chon diem can tim cao do :"))
(setq L (+ cdd (- (cadr p2) (cadr p1))))
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te))(princ))
;---
(defun C:4( / L te p1 p2)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))(setq p2 (getpoint p1 "\n Chon diem thu hai :")))
(setq L (distance p1 p2))
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :"))) te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te))(princ))

Bác sửa lisp cao độ này rất hay, nhưng em muốn nhờ bác sửa lisp đo khoảng cách ngắn gọn hơn 1 bước nữa được không?

Nghĩa là: gõ lisp\chọn điểm gốc\chọn điểm còn lại\chọn text (1 điểm gốc tính khoảng cách cho tất cả các điểm còn lại giống như lisp cao độ)

Thanks bác nhiều nha!


  • 0

#7 namtrantt206xd

namtrantt206xd

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 13 June 2014 - 04:26 PM

Bác TaiNguyen79 sửa giúp em lisp khoảng cách với? như lisp đo cao độ nhưng mà giờ là đo khoảng cách.


  • 0

#8 namtrantt206xd

namtrantt206xd

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 14 June 2014 - 10:13 AM

Có ai giúp em với?


  • 0

#9 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 June 2014 - 10:57 AM

Có phải là như vầy không?

(defun C:4 (/ L te p1 p2)
(setq p1 (getpoint "\n Chon diem thu nhat :"))
(while (setq p2 (getpoint p1 "\n Chon diem thu hai :"))
(setq L (distance p1 p2))
(setq te (entget (car (entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)    
(princ)
)

  • 0

#10 namtrantt206xd

namtrantt206xd

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 14 June 2014 - 11:35 AM

Đúng theo ý em rồi bác ah? nhưng mà không hiểu sao kết quả ghi khoảng cách ra lại không đúng bác nhỉ?


  • 0

#11 namtrantt206xd

namtrantt206xd

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 14 June 2014 - 11:39 AM

Em hiểu rồi, như thế này là lisp đang đo khoảng cách 2 điểm như lệnh DAL nhưng em muốn lisp đó khoảng cách như lệnh DLI thì bác sử giúp em được không?


  • 0

#12 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 June 2014 - 11:43 AM

Đây là lisp đường hàn. Có 5 kiểu hàn lần lượt gỏ lệnh CTT_CTK_DH_DHH_HK

Dùng lệnh: 1/ Pick điểm đầu và điểm cuối của đường thẳng

2/ Chọn khoảng cách và chiều cao đường hàn

Riêng Lệnh DH có chọn Pick chọn phía hàn.

Qua theo dõi trên diễn đàn thấy bạn Tot77 rất nhiệt tâm và "Good" về lisp. Vậy nhờ bác Tot77 hoặc bác nào rành

về lisp giúp tôi cải tiến thêm các lệnh CTT_CTK_DHH_HK có thể Pick chọn phía hàn. Tôi chỉ biết dùng lisp, không hiểu nhiều

về viết lisp. Nhờ các bác giúp!

http://www.cadviet.c...k_dh_dhh_hk.lsp


  • 0

#13 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 June 2014 - 11:50 AM

Khoảng cách ở đây là tỷ lệ 1:1, bạn đo bằng lệnh dist.

Đo theo DLI có 2 phương x,y, bạn muốn đo theo phương nào?

 

@phamhung12 : lisp không down được, bạn gửi theo cách khác.


  • 0

#14 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 June 2014 - 12:38 PM

;;;Ve duong han
=========================
;;CHUONG TRINH HAN THEP
; Duong han cong truong thuong
(defun C:CTT ( / )
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
	   (if (= b nil) (setq b (* 0.75 a)))
	   (setq l  (distance p1 p2) )
	   (setq n  (fix ( / l a ) ) )
	   (setq deltaX ( - (car p2) (car p1) ) )
	   (setq deltaY ( - (cadr p2) (cadr p1) ) )
	   (setq i 0)
; Luu bien he thong
	   (setq osmodeold (getvar "osmode")) 
	   (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
	   (command "_UNDO" "_GROUP")
	   (setvar "OSMODE" 0)
	   (setvar "BLIPMODE" 0)		
; Them mot vong lap cho i
	   (while (<= i n )
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX ))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
		(setq p3 (list x1 y1) )
		(setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l)))) (* b (/ deltaX l)))) 
		(setq y2 ( + (+ y1 (* b (/ deltaX l))) (* b (/ deltaY l))))
		(setq p4 (list x2 y2))
		(setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y5 ( + y1 (* b (/ deltaX l)))) 
		(setq p5 (list x5 y5))
		(setq x6 ( + x1  (* b (/ deltaX l)))) 
		(setq y6 ( + y1 (* b (/ deltaY l)))) 
		(setq p6 (list x6 y6) )
		(command "LINE" p3 p4 "")
		(command "LINE" p5 p6 "")
		(setq i (+ i 1))
	   )
	   (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
	   (setvar "BLIPMODE" blipmodeold)		
	   (setvar "OSMODE" osmodeold)
	   (princ)
)
;;==============================================================================

=========================
; Duong han cong truong net khuat
(defun C:CTK ( / )
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "OK\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
	   (if (= b nil) (setq b (* 0.75 a)))
	   (setq l  (distance p1 p2))
	   (setq n (fix ( / l a )))
	   (setq deltaX (- (car p2) (car p1)))
	   (setq deltaY (- (cadr p2) (cadr p1)))
	   (setq i 0)
; Luu bien he thong
	   (setq osmodeold (getvar "osmode")) 
	   (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
	   (command "_UNDO" "_GROUP")
	   (setvar "OSMODE" 0)
	   (setvar "BLIPMODE" 0)		
; Them mot vong lap cho i
	   (while (<= i n )
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY ))))
		(setq p3 (list x1 y1))
		(setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l) ) ) ) (* b (/ deltaX l)))) 
		(setq y2 ( + (+ y1 (* b (/ deltaX l) ) ) (* b (/ deltaY l))))
		(setq p4 (list x2 y2))
		(setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y5 ( + y1 (* b (/ deltaX l)))) 
		(setq p5 (list x5 y5))
		(setq x6 ( + x1  (* b (/ deltaX l)))) 
		(setq y6 ( + y1 (* b (/ deltaY l)))) 
		(setq p6 (list x6 y6) )
	(if (< (rem i 6) 4)		
	   	(progn
		 (command "LINE" p3 p4 "")
		   	 (command "LINE" p5 p6 "")
		)
		) 
	(setq i (+ i 1))
	   )
	   (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
	   (setvar "BLIPMODE" blipmodeold)		
	   (setvar "OSMODE" osmodeold)
	   (princ)
)
;;==============================================================================
(defun C:DH()
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho")) )
(setvar "cmdecho" 0)
   (setq P1 (getpoint "\nDiem dau : "))
   (setq P2 (getpoint p1 "\nDiem cuoi : "))
   (setq P3 (getpoint p1 "\nPhia co duong han : "))
   (setq  l (getreal  "\nChieu cao duong han : "))
   (setq goc (angle p1 p2))
   (setq xA (car P1))
   (setq yA (cadr P1))
   (setq xB (car P2))
   (setq yB (cadr P2))
   (setq xC (car P3))
   (setq yC (cadr P3))
   (setq dau (- (* (- xC xA) (- yB yA)) (* (- xB xA) (- yC yA))))
   (setq n (distance P1 P2))
   (setq x1 (- xA (* l (cos goc))))
   (setq y1 (- yA (* l (sin goc))))
(setvar "osmode" 0)
   (While (> n 0)
	  (setq x1 (+ x1 (* l (cos goc))))
	  (setq y1 (+ y1 (* l (sin goc))))
	  (setq x2 (- x1 (* l (sin goc))))
	  (setq y2 (+ y1 (* l (cos goc))))
	  (setq x3 (+ x1 (* l (sin goc))))
	  (setq y3 (- y1 (* l (cos goc))))
	  (setq dau2 (- (* (- x2 xA) (- yB yA)) (* (- xB xA) (- y2 yA))))
	  (if (> (* dau2 dau) 0)	   
		(command "line" (list x1 y1) (list x2 y2) "")
		(command "line" (list x1 y1) (list x3 y3) "")
	  )
	  (setq n (- n l))
   );of while
(mapcar 'setvar (list "osmode" "cmdecho") om)
(command "undo" "e")
(PRINC)
); of defun
;;==============================================================================

=========================
;bo sung duong han net khuat
; Duong han
(defun C:DHH ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
	   (setq l  (distance p1 p2))
	   (setq n  (fix ( / l a ) ) )
	   (setq deltaX (- (car p2) (car p1)))
	   (setq deltaY (- (cadr p2) (cadr p1)))
	   (setq i 0)
	   (setvar "osmode" 0)
	   (setvar "BLIPMODE" 0)		
	   ;(command "_UNDO" "_GROUP");
	   (while (<= i n)
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
		(setq p3 (list x1 y1))
		(setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y2 ( + y1 (* b (/ deltaX l)))) 
		(setq p4 (list x2 y2))
		(command "LINE" p3 p4 "")
		(setq i (+ i 1))
	   )
	  (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
	   (princ)
)
;;==============================================================================

=========================
; Duong han net khuat
(defun C:HK ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
	   (setq p1 (getpoint "\nStart point : ") )
	   (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
	   (if (null a) (setq a 1.0))
	   (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
	   (if (/= _a nil) (setq a _a))
	   (if (null b) (setq b 1.0))
	   (setq _b (getdist (strcat "Ok\nLenght <" (rtos b 2 1) ">: ")))
	   (if (/= _b nil) (setq b _b))
 
	   (setq l  (distance p1 p2) )
	   (setq n  (fix ( / l a ) ) )
	   (setq deltaX ( - (car p2) (car p1) ) )
	   (setq deltaY ( - (cadr p2) (cadr p1) ) )
	   (setq i 0)
	   (setvar "OSMODE" 0)
	   (setvar "BLIPMODE" 0)		
	   ;(command "_UNDO" "_GROUP");
	   (while (<= i n)
		(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
		(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
		(setq p3 (list x1 y1))
		(setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
		(setq y2 ( + y1 (* b (/ deltaX l)))) 
		(setq p4 (list x2 y2))
	(if (< (rem i 6) 4)		
			  (command "LINE" p3 p4 "")
		)  
		(setq i (+ i 1))
	   )
		  (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
	   (princ)
)

  • 0

#15 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 June 2014 - 03:45 PM

@phamhung12 Đã sữa lại.

;;;Ve duong han
=========================
;;CHUONG TRINH HAN THEP
; Duong han cong truong thuong
(defun C:CTT ( / )
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
  (if (= b nil) (setq b (* 0.75 a)))
           (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil))
           (if (equal (cos (angle d c)) (cos (+ 1.5708 (angle p1 p2))) 0.001)
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2) )
  (setq n  (fix ( / l a ) ) )
  (setq deltaX ( - (car p2) (car p1) ) )
  (setq deltaY ( - (cadr p2) (cadr p1) ) )
  (setq i 0)
; Luu bien he thong
  (setq osmodeold (getvar "osmode")) 
  (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
  (command "_UNDO" "_GROUP")
  (setvar "OSMODE" 0) (setvar 'cmdecho 0)
  (setvar "BLIPMODE" 0) 
; Them mot vong lap cho i
  (while (<= i n )
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX ))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
(setq p3 (list x1 y1) )
;;; (setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l) ) ) ) (* b (/ deltaX l)))) 
;;; (setq y2 ( + (+ y1 (* b (/ deltaX l) ) ) (* b (/ deltaY l))))
;;; (setq p4 (list x2 y2))
;;; (setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y5 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p5 (list x5 y5))
       (setq x6 ( + x1  (* b (/ deltaX l)))) 
(setq y6 ( + y1 (* b (/ deltaY l)))) 
(setq p6 (list x6 y6) )      
       (setq p5 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
       (setq p4 (polar p6 ((eval lenh) (angle p1 p2) 1.5708) b))
(command "LINE" p3 p4 "")
(command "LINE" p5 p6 "")
(setq i (+ i 1))
  )
  (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
  (setvar "BLIPMODE" blipmodeold) 
  (setvar "OSMODE" osmodeold)(setvar 'cmdecho 1)
  (princ)
)
;;==============================================================================
 
=========================
; Duong han cong truong net khuat
(defun C:CTK ( / )
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "OK\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
  (if (= b nil) (setq b (* 0.75 a)))
           (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil))
           (if (equal (cos (angle d c)) (cos (+ 1.5708 (angle p1 p2))) 0.001)
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2))
  (setq n (fix ( / l a )))
  (setq deltaX (- (car p2) (car p1)))
  (setq deltaY (- (cadr p2) (cadr p1)))
  (setq i 0)
; Luu bien he thong
  (setq osmodeold (getvar "osmode")) 
  (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
  (command "_UNDO" "_GROUP")
  (setvar "OSMODE" 0)
  (setvar "BLIPMODE" 0)  (setvar 'cmdecho 0) 
; Them mot vong lap cho i
  (while (<= i n )
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY ))))
(setq p3 (list x1 y1))
;;; (setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l) ) ) ) (* b (/ deltaX l)))) 
;;; (setq y2 ( + (+ y1 (* b (/ deltaX l) ) ) (* b (/ deltaY l))))
;;; (setq p4 (list x2 y2))
;;; (setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y5 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p5 (list x5 y5))
(setq x6 ( + x1  (* b (/ deltaX l)))) 
(setq y6 ( + y1 (* b (/ deltaY l)))) 
(setq p6 (list x6 y6) )
       (setq p5 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
       (setq p4 (polar p6 ((eval lenh) (angle p1 p2) 1.5708) b))
(if (< (rem i 6) 4) 
   (progn
(command "LINE" p3 p4 "")
(command "LINE" p5 p6 "")
)
) 
(setq i (+ i 1))
  )
  (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
  (setvar "BLIPMODE" blipmodeold) 
  (setvar "OSMODE" osmodeold)  (setvar 'cmdecho 1)
  (princ)
)
;;==============================================================================
(defun C:DH()
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho")) )
(setvar "cmdecho" 0)
   (setq P1 (getpoint "\nDiem dau : "))
   (setq P2 (getpoint p1 "\nDiem cuoi : "))
   (setq P3 (getpoint p1 "\nPhia co duong han : "))
   (setq  l (getreal  "\nChieu cao duong han : "))
   (setq goc (angle p1 p2))
   (setq xA (car P1))
   (setq yA (cadr P1))
   (setq xB (car P2))
   (setq yB (cadr P2))
   (setq xC (car P3))
   (setq yC (cadr P3))
   (setq dau (- (* (- xC xA) (- yB yA)) (* (- xB xA) (- yC yA))))
   (setq n (distance P1 P2))
   (setq x1 (- xA (* l (cos goc))))
   (setq y1 (- yA (* l (sin goc))))
(setvar "osmode" 0)
   (While (> n 0)
 (setq x1 (+ x1 (* l (cos goc))))
 (setq y1 (+ y1 (* l (sin goc))))
 (setq x2 (- x1 (* l (sin goc))))
 (setq y2 (+ y1 (* l (cos goc))))
 (setq x3 (+ x1 (* l (sin goc))))
 (setq y3 (- y1 (* l (cos goc))))
 (setq dau2 (- (* (- x2 xA) (- yB yA)) (* (- xB xA) (- y2 yA))))
 (if (> (* dau2 dau) 0)    
(command "line" (list x1 y1) (list x2 y2) "")
(command "line" (list x1 y1) (list x3 y3) "")
 )
 (setq n (- n l))
   );of while
(mapcar 'setvar (list "osmode" "cmdecho") om)
(command "undo" "e")
(PRINC)
); of defun
;;==============================================================================
 
=========================
;bo sung duong han net khuat
; Duong han
(defun C:DHH ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
           (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil))
           (if (equal (cos (angle d c)) (cos (+ 1.5708 (angle p1 p2))) 0.001)
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2))
  (setq n  (fix ( / l a ) ) )
  (setq deltaX (- (car p2) (car p1)))
  (setq deltaY (- (cadr p2) (cadr p1)))
  (setq i 0)
  (setvar "osmode" 0)
  (setvar "BLIPMODE" 0) 
  ;(command "_UNDO" "_GROUP");
  (while (<= i n)
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
(setq p3 (list x1 y1))
;;; (setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y2 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p4 (list x2 y2))
       (setq p4 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
(command "LINE" p3 p4 "")
(setq i (+ i 1))
  )
 (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
  (princ)
)
;;==============================================================================
 
=========================
; Duong han net khuat
(defun C:HK ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
           (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil))
           (if (equal (cos (angle d c)) (cos (+ 1.5708 (angle p1 p2))) 0.001)
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2) )
  (setq n  (fix ( / l a ) ) )
  (setq deltaX ( - (car p2) (car p1) ) )
  (setq deltaY ( - (cadr p2) (cadr p1) ) )
  (setq i 0)
  (setvar "OSMODE" 0)
  (setvar "BLIPMODE" 0) 
  ;(command "_UNDO" "_GROUP");
  (while (<= i n)
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
(setq p3 (list x1 y1))
;;; (setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y2 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p4 (list x2 y2))
       (setq p4 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
(if (< (rem i 6) 4) 
 (command "LINE" p3 p4 "")
)  
(setq i (+ i 1))
  )
 (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
  (princ)
)
 

 

@namtran : Không thấy bạn trả lời, đoán là đo khoảng cách theo phương x.

(defun C:4 (/ L te p1 p2)
(setq p1 (getpoint "\n Chon diem thu nhat :"))
(while (setq p2 (getpoint p1 "\n Chon diem thu hai :"))
(setq L (abs (- (car p1) (car p2))))
(setq te (entget (car (entsel "\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te)
)    
(princ)
)
 

  • 1

#16 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 June 2014 - 09:08 PM

Đã test. Nhưng bạn Tot77 ơi, pick hướng nào thì đường hản cũng ở phía trên đường thẳng...Bạn xem lại giúp mình với. Thanks!


  • 0

#17 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 June 2014 - 10:45 PM

Tôi quên test trường hợp line nằm ngang, chỉ test line xiên. Sửa lại.

;;;Ve duong han
=========================
;;CHUONG TRINH HAN THEP
; Duong han cong truong thuong
(defun C:CTT ( / )
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
  (if (= b nil) (setq b (* 0.75 a)))
  
  (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil)
le (if (equal (cos (angle p1 p2)) 1 0.001) 'sin 'cos))
  (if (equal ((eval le) (angle d c)) ((eval le) (+ 1.5708 (angle p1 p2))) 0.001) 
    (setq lenh '+) (setq lenh '-))
  
  (setq l  (distance p1 p2) )
  (setq n  (fix ( / l a ) ) )
  (setq deltaX ( - (car p2) (car p1) ) )
  (setq deltaY ( - (cadr p2) (cadr p1) ) )
  (setq i 0)
; Luu bien he thong
  (setq osmodeold (getvar "osmode")) 
  (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
  (command "_UNDO" "_GROUP")
  (setvar "OSMODE" 0) (setvar 'cmdecho 0)
  (setvar "BLIPMODE" 0) 
; Them mot vong lap cho i
  (while (<= i n )
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX ))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
(setq p3 (list x1 y1) )
;;; (setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l) ) ) ) (* b (/ deltaX l)))) 
;;; (setq y2 ( + (+ y1 (* b (/ deltaX l) ) ) (* b (/ deltaY l))))
;;; (setq p4 (list x2 y2))
;;; (setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y5 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p5 (list x5 y5))
(setq x6 ( + x1  (* b (/ deltaX l)))) 
(setq y6 ( + y1 (* b (/ deltaY l)))) 
(setq p6 (list x6 y6) )      
(setq p5 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
(setq p4 (polar p6 ((eval lenh) (angle p1 p2) 1.5708) b))
(command "LINE" p3 p4 "")
(command "LINE" p5 p6 "")
(setq i (+ i 1))
  )
  (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
  (setvar "BLIPMODE" blipmodeold) 
  (setvar "OSMODE" osmodeold)(setvar 'cmdecho 1)
  (princ)
)
;;==============================================================================
 
=========================
; Duong han cong truong net khuat
(defun C:CTK ( / )
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "OK\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
; Chieu cao duong han lay mac dinh bang 0,75 khoang cach
  (if (= b nil) (setq b (* 0.75 a)))
  (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil)
le (if (equal (cos (angle p1 p2)) 1 0.001) 'sin 'cos))
  (if (equal ((eval le) (angle d c)) ((eval le) (+ 1.5708 (angle p1 p2))) 0.001) 
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2))
  (setq n (fix ( / l a )))
  (setq deltaX (- (car p2) (car p1)))
  (setq deltaY (- (cadr p2) (cadr p1)))
  (setq i 0)
; Luu bien he thong
  (setq osmodeold (getvar "osmode")) 
  (setq blipmodeold (getvar "blipmode")) 
; Undo phai de truoc lenh chinh bien he thong
  (command "_UNDO" "_GROUP")
  (setvar "OSMODE" 0)
  (setvar "BLIPMODE" 0)  (setvar 'cmdecho 0) 
; Them mot vong lap cho i
  (while (<= i n )
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY ))))
(setq p3 (list x1 y1))
;;; (setq x2 ( + ( + x1 (* -1 (* b (/ deltaY l) ) ) ) (* b (/ deltaX l)))) 
;;; (setq y2 ( + (+ y1 (* b (/ deltaX l) ) ) (* b (/ deltaY l))))
;;; (setq p4 (list x2 y2))
;;; (setq x5 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y5 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p5 (list x5 y5))
(setq x6 ( + x1  (* b (/ deltaX l)))) 
(setq y6 ( + y1 (* b (/ deltaY l)))) 
(setq p6 (list x6 y6) )
       (setq p5 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
       (setq p4 (polar p6 ((eval lenh) (angle p1 p2) 1.5708) b))
(if (< (rem i 6) 4) 
   (progn
(command "LINE" p3 p4 "")
(command "LINE" p5 p6 "")
)
) 
(setq i (+ i 1))
  )
  (command "_UNDO" "_END")
; Khoi phuc lai cac bien he thong da thay doi
  (setvar "BLIPMODE" blipmodeold) 
  (setvar "OSMODE" osmodeold)  (setvar 'cmdecho 1)
  (princ)
)
;;==============================================================================
(defun C:DH()
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho")) )
(setvar "cmdecho" 0)
   (setq P1 (getpoint "\nDiem dau : "))
   (setq P2 (getpoint p1 "\nDiem cuoi : "))
   (setq P3 (getpoint p1 "\nPhia co duong han : "))
   (setq  l (getreal  "\nChieu cao duong han : "))
   (setq goc (angle p1 p2))
   (setq xA (car P1))
   (setq yA (cadr P1))
   (setq xB (car P2))
   (setq yB (cadr P2))
   (setq xC (car P3))
   (setq yC (cadr P3))
   (setq dau (- (* (- xC xA) (- yB yA)) (* (- xB xA) (- yC yA))))
   (setq n (distance P1 P2))
   (setq x1 (- xA (* l (cos goc))))
   (setq y1 (- yA (* l (sin goc))))
(setvar "osmode" 0)
   (While (> n 0)
 (setq x1 (+ x1 (* l (cos goc))))
 (setq y1 (+ y1 (* l (sin goc))))
 (setq x2 (- x1 (* l (sin goc))))
 (setq y2 (+ y1 (* l (cos goc))))
 (setq x3 (+ x1 (* l (sin goc))))
 (setq y3 (- y1 (* l (cos goc))))
 (setq dau2 (- (* (- x2 xA) (- yB yA)) (* (- xB xA) (- y2 yA))))
 (if (> (* dau2 dau) 0)    
(command "line" (list x1 y1) (list x2 y2) "")
(command "line" (list x1 y1) (list x3 y3) "")
 )
 (setq n (- n l))
   );of while
(mapcar 'setvar (list "osmode" "cmdecho") om)
(command "undo" "e")
(PRINC)
); of defun
;;==============================================================================
 
=========================
;bo sung duong han net khuat
; Duong han
(defun C:DHH ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
  (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil)
le (if (equal (cos (angle p1 p2)) 1 0.001) 'sin 'cos))
  (if (equal ((eval le) (angle d c)) ((eval le) (+ 1.5708 (angle p1 p2))) 0.001) 
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2))
  (setq n  (fix ( / l a ) ) )
  (setq deltaX (- (car p2) (car p1)))
  (setq deltaY (- (cadr p2) (cadr p1)))
  (setq i 0)
  (setvar "osmode" 0)
  (setvar "BLIPMODE" 0) 
  ;(command "_UNDO" "_GROUP");
  (while (<= i n)
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
(setq p3 (list x1 y1))
;;; (setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y2 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p4 (list x2 y2))
       (setq p4 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
(command "LINE" p3 p4 "")
(setq i (+ i 1))
  )
 (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
  (princ)
)
;;==============================================================================
 
=========================
; Duong han net khuat
(defun C:HK ( / )
(command "undo" "be")
(setq om (mapcar 'getvar (list "osmode" "cmdecho" "BLIPMODE")))
(setvar "cmdecho" 0)
  (setq p1 (getpoint "\nStart point : ") )
  (setq p2 (getpoint p1 "Ok\nEnd point   : ") )
  (if (null a) (setq a 1.0))
  (setq _a (getdist (strcat "Ok\nDistance <" (rtos a 2 1) ">: ")))
  (if (/= _a nil) (setq a _a))
  (if (null b) (setq b 1.0))
  (setq _b (getdist (strcat "Ok\nLength <" (rtos b 2 1) ">: ")))
  (if (/= _b nil) (setq b _b))
  (setq c (getpoint (strcat "\nPick Side: "))
d (inters p1 p2 c (polar c (+ 1.5708 (angle p1 p2)) 1) nil)
le (if (equal (cos (angle p1 p2)) 1 0.001) 'sin 'cos))
  (if (equal ((eval le) (angle d c)) ((eval le) (+ 1.5708 (angle p1 p2))) 0.001) 
    (setq lenh '+) (setq lenh '-))
  (setq l  (distance p1 p2) )
  (setq n  (fix ( / l a ) ) )
  (setq deltaX ( - (car p2) (car p1) ) )
  (setq deltaY ( - (cadr p2) (cadr p1) ) )
  (setq i 0)
  (setvar "OSMODE" 0)
  (setvar "BLIPMODE" 0) 
  ;(command "_UNDO" "_GROUP");
  (while (<= i n)
(setq x1 ( + (car p1) (* i (* (/ a l) deltaX))))
(setq y1 ( + (cadr p1) (* i (* ( / a l ) deltaY))))
(setq p3 (list x1 y1))
;;; (setq x2 ( + x1 (* -1 (* b (/ deltaY l))))) 
;;; (setq y2 ( + y1 (* b (/ deltaX l)))) 
;;; (setq p4 (list x2 y2))
       (setq p4 (polar p3 ((eval lenh) (angle p1 p2) 1.5708) b))
(if (< (rem i 6) 4) 
 (command "LINE" p3 p4 "")
)  
(setq i (+ i 1))
  )
 (mapcar 'setvar (list "osmode" "cmdecho" "BLIPMODE") om)
(command "undo" "e")
  (princ)
)
 
 

  • 1

#18 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 June 2014 - 11:16 PM

Đã test. Bạn thật tuyệt vời! Thanks!!!


  • 0

#19 namtrantt206xd

namtrantt206xd

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 15 June 2014 - 11:43 AM

Tot77 Chuẩn rồi bạn ơi, thanks bạn rất nhiều nhé.hi
  • 0

#20 xhxdxm

xhxdxm

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 10 November 2014 - 04:58 PM

Sửa cho bạn đây :


(defun C:f2( / cdd L te p1 p2)
(setq cdd (atof (cdr(assoc 1 (entget(car(entsel "\n Pick chon Text cao do dau :")))))))
(setq p1 (getpoint "\n Chon diem da biet cao do:"))
(while (setq p2 (getpoint p1 "\n Chon diem can tim cao do :"))
(setq L (+ cdd (- (cadr p2) (cadr p1))))
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :")))
te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te))(princ))
;---
(defun C:4( / L te p1 p2)
(while (and (setq p1 (getpoint "\n Chon diem thu nhat :"))(setq p2 (getpoint p1 "\n Chon diem thu hai :")))
(setq L (distance p1 p2))
(setq te (entget(car(entsel"\n Chon Text de gan ket qua :"))) te (subst (cons 1 (rtos L 2 2)) (assoc 1 te) te))
(entmod te))(princ))

Thankssssssss bạn nhé


  • 0