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

[ Nhờ sửa Lisp] chỉnh tên cạnh

Bởi tientracdia , trong AutoLisp

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

tientracdia    16

tientracdia
Đã đăng

Mình có liisp sưu tầm được mục đích chọn vào vùng tâm thửa chỉ ra điểm chèn, mình muốn thêm tên cạch vào bảng

(defun c:HSKT2( / ss lst fn fid lstEn)
(vl-load-com)
(command "-purge" "a" "" "N")
(command "attdisp" "ON")
  (styf)
  (Setq Tlebd (LM:GetXWithDefault getreal "\n Nhap ty le ban do: " '*Tlebd* (atof "1000")))
  (setq TLE (/ Tlebd 1000))
  (progn
	(setvar "hpgaptol" 0.5)
	(setq Olmode (getvar "OSMODE"))
	(setvar "OSMODE" 0)
	
	(setq Clor (getvar "CECOLOR"))
	(setq pt (getpoint "\n Pick diem trong vung can trich thua :"))
	(vl-cmdf  "-boundary" pt "")
        (setq Elast1 (entlast))
    	(dch (entget Elast1))
    	(setq Elast (entlast))
  	(setq en Elast
      	      ob (vlax-ename->vla-object  en)
               n (vlax-curve-getEndParam ob)
               i 0
        )
  	(setq Pd (vlax-curve-getPointAtParam ob 0)
	      Pc (vlax-curve-getPointAtParam ob n)
	     KCC (rtos (distance Pd Pc) 2 2)
	)
  	(setq P1dau (vlax-curve-getPointAtParam ob 0))
	(setq Xdau (rtos (car P1dau) 2 2))
  	(setq Ydau (rtos (cadr P1dau) 2 2))
  
  	(setq P_ddat (getpoint "\n Chon diem dat: "))
  	(setq P_a1 (polar P_ddat 0 (* TLE 207.0)))		; chieu dai rong khung
  	(setq P1 (polar P_a1 (/ pi 2) (* TLE 124.3)))

    
  	(command "insert" "HSKT" P_ddat TLE TLE  0 (rtos (Area Elast)  2 2) (rtos Tlebd  2 0)) ;; chen khung, dtich, ti le
  	(setq P2  (polar P1 0 (* TLE 20.0)))
  	(setq P3  (polar P1 0 (* Tle 43.0)))
  	(setq P4a (polar P1 0 (* TLE 62.0)))
  	(setq P4 (polar P4a (DTR 270) (* TLE 2.5)))
	;;
	(setq P5a (polar P1 0 (* TLE 82.0)))
  	(setq P5 (polar P5a (DTR 270) (* TLE 2.5)))
	;;
  	(setq P1DD (polar P1 (DTR 270) (* n (* TLE 5.0))))
  	(setq P2DD (polar P2 (DTR 270) (* n (* TLE 5.0))))
  	(setq P3DD (polar P3 (DTR 270) (* n (* TLE 5.0))))
  
  	(MakeText P1DD (rtos 1 2 0) (* TLE 2.5) 0 "C")
  	(MakeText P2DD Xdau         (* TLE 2.5) 0 "C")
  	(MakeText P3DD Ydau         (* TLE 2.5) 0 "C")
  	
	(while (< i n)
		(setq p (vlax-curve-getPointAtParam ob i))
	  	(setq p_2 (vlax-curve-getPointAtParam ob (+ i 1)))
		(setq X (rtos (car P) 2 2))
	  	(setq Y (rtos (cadr P) 2 2))
		
		;(setq TE ((vlax-curve-getPointAtParam ob i) "  -  " (vlax-curve-getPointAtParam ob (+ i 1))));;
	  	(setq KC (rtos (distance P P_2) 2 2))
		;;
		
		;;
	  	(setq P1_i (Polar P1 (DTR 270) (* i (* TLE 5.0))))
	  	(setq P2_i (Polar P2 (DTR 270) (* i (* TLE 5.0))))
	  	(setq P3_i (Polar P3 (DTR 270) (* i (* TLE 5.0))))
	  	(setq P4_i (Polar P4 (DTR 270) (* i (* TLE 5.0))))
	  	;;
		(setq P5_i (Polar P5 (DTR 270) (* i (* TLE 5.0))));;
		;;
	  	(MakeText P1_i (rtos (+ i 1) 2 0) (* TLE 2.5) 0 "C")	; viet stt
	  	(MakeText P2_i X (* TLE 2.5) 0 "C")						; viet tdo x
	  	(MakeText P3_i Y (* TLE 2.5) 0 "C")						; viet tdo y
		(MakeText P4_i (rtos (+ i 1) 2 0) (* TLE 2.5) 0 "C")	; viet stt
		(MakeText P5_i KC (* TLE 2.5) 0 "C")					; viet khoang cach
		
		(setq i (1+ i))											; lap lai cac diem
	)
)
;(setq P_a2 (polar P_ddat 0 (* TLE 138.3)))
(setq P_a2 (polar P_ddat 0 (* TLE 138.3)))				;; vi tri cat thua
(setq Pnt1 (polar P_a2 (/ pi 2) (* TLE 94.5)))
(command "copy" Elast "" (mid Elast) Pnt1 "")
(GKT Pnt1 TLE )


(setvar "OSMODE" Olmode)
(princ)
)
;;--------------------------------------------------------
(defun GKT (Pt TLE / lst fn fid lstEn);Ghi kich thuoc
(vl-load-com)
	(setvar "hpgaptol" 0.5)
	(setq Olmode (getvar "OSMODE"))
	(setvar "OSMODE" 0)
	(setq Clor (getvar "CECOLOR"))
	(vl-cmdf  "-boundary" Pt "")
        (setq Elast (entlast))
  	(dch (entget Elast))
  	(setq en Elast
      	      ob (vlax-ename->vla-object  en)
               n (vlax-curve-getEndParam ob)
               i 0
        )
  	
	(while (< i n)
		(setq P (vlax-curve-getPointAtParam ob i))
	  	(command "insert" "tron" p TLE TLE 0)			; chen diem vong tron
	  	(setq P_2 (vlax-curve-getPointAtParam ob (+ i 1)))
	  	(setq goc (angle P P_2))
	  	(setq KC_i  (distance P P_2) )
	  	(setq DG_i (polar P goc (/ KC_i 2)))
	  	(setq Pii (polar P (/ pi 2) (* TLE 2)))
	  	(MakeText Pii (rtos (+ i 1) 2 0) (* TLE 2.5) 0 "C")
	  	(setq PVi (Atan2 P P_2))
	  	(if (< (Rad_to_Do PVi) 180)
		  (progn
		    (setq PG_ia (polar DG_i (+ (/ pi 2) goc) 1.0))
	  	    (MakeText PG_ia (rtos KC_i 2 2) (* TLE 2.5) goc "C")
		  )
		  (progn
		    (setq PG_ib (polar DG_i (+ (/ pi 2) (angle P_2 P)) 1.0))
		    (MakeText PG_ib (rtos KC_i 2 2) (* TLE 2.5)  (angle P_2 P) "C")
		  )
		)
		(setq i (1+ i))
	)
(MakeText (mid Elast) (rtos (Area Elast)  2 2)  (* TLE 2.5)  0 "C")	; viet dtich tren thua cat
(entdel Elast)
(setvar "OSMODE" Olmode)
;;;(princ )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Area (ent)
(setvar "hpgaptol" 0.1)
(vla-get-area (vlax-ename->vla-object ent))
)
;;-----------
(defun mid (ent / p1 p2)
	(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
	(setq p1 (vlax-safearray->list p1)
				p2 (vlax-safearray->list p2)
				pt (mapcar '+ p1 p2)
				pt (mapcar '* pt '(0.5 0.5 0.5))
	)
	pt
)
;;--------
(defun wtxt_l(txt p / sty d h1 h2 wf h) ;;;Write txt on graphic screen at p
(setq    sty (getvar "textstyle")    
d (tblsearch "style" sty)    
h1 (cdr (assoc 40 d))    
h2 (cdr (assoc 42 d))    
wf (cdr (assoc 41 d)))
(if (> h1 0) (setq h h1) (setq h h2))
(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 40 h) (cons 41 wf)(cons 72 4)(cons 11 p)(cons 62 4) (cons 1 txt) (cons 10 p)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)

(defun DTR (Do / radian)
   (setq radian  (/ (* Do pi ) 180))
)
(defun LM:GetXWithDefault ( _function _prompt _symbol _default / _toString )
	(setq _toString
		(lambda ( x )
			(cond
				( (eq getangle _function) (angtos x) )
				( (eq 'REAL (type x)) (rtos x) )
				( (eq 'INT (type x)) (itoa x) )
				( x )
			)
		)
	)

	(set _symbol
	(
	(lambda ( input ) (if (or (not input) (eq "" input)) (eval _symbol) input))
	(_function (strcat _prompt "<" (_toString (set _symbol (cond ( (eval _symbol) ) ( _default )))) "> : "))
	)
	)
)

(defun MakeText (point string Height Ang justify     / Lst); Ang: Radial
	(setq Lst (list '(0 . "TEXT")
			(cons 8 (if Layer Layer (getvar "Clayer")))
			(cons 62 (if Color Color 256))
			(cons 10 point)
			(cons 40 Height)
			(cons 1 string)
			(cons 50 Ang)
		)
	justify (strcase justify)
      )
      (cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
			((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
			((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
			((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))
			((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))
			((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))	
			((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))
			((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))
			((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))
			((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))
			((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))
			((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
      )
     (entmakex Lst)
 )


;revlwpl
(defun dch (ent / eo el len)
(vl-load-com)
(setq eo ent)
(setq el (list(assoc 210 ent)))
(while (member (assoc 10 ent) ent)
  (if (= 0.0 (assoc 42 ent))
(setq el (cons (assoc 42 ent) el))
(setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
  )
  (setq el (cons (assoc 41 ent) el))
  (setq el (cons (assoc 40 ent) el))
  (setq el (cons (assoc 10 ent) el))
  (setq ent (member (assoc 10 ent) ent))
  (setq ent (cdr ent))
)
(setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
(while (>= len 0)
  (setq el (cons (nth len eo) el))
  (setq len (- len 1))
)
(setq ent el)
(entmod ent)
(princ)
)

(defun Rad_to_Do(radian / Do)
   (setq Do (/ (* radian 180) pi))
)
(defun Do_to_Radian (Do / radian)
   (setq radian  (/ (* Do pi ) 180))
)
(defun R2DPG (gocR / DPG Toando Do Phut1 Phut Giay DPG)
  (setq DPG (list))
  (setq Toando (Rad_to_Do gocR))
  (setq Do (fix Toando))
  (setq Phut1  (* (- Toando Do) 60))
  (setq Phut (fix Phut1))
  (setq Giay   (atof (rtos (* (- phut1 phut) 60) 2 3)))
  (setq DPG (list Do  Phut giay))
  DPG
)
(defun DPG_to_DO (Goc)
(setq DD (nth 0 Goc))
(setq PP (/ (nth 1 Goc) 60))
(setq GG (/ (nth 2 Goc) 3600))
(setq DDD (+ DD PP GG))
DDD
)
(defun Dogoc2diem (P1 P2 /)
  (setq gocP12 (angle P1 P2))
  (setq gocP12_DPG (R2DPG gocP12))
  (setq Goc_12 (DPG_to_DO gocP12_DPG))
  Goc_12
)
(defun Do_to_DPG (Toando /)
  (setq Do (fix Toando))
  (setq Phut1 (* (- Toando Do) 60))
  (setq Phut (fix Phut1))
  (setq Giay   (atof (rtos (* (- phut1 phut) 60) 2 3)))
  (setq DPG (list Do  Phut giay))
  DPG
)

(defun Atan2 (P1 P2 / gocAtan b)
  (setq dx ( - (car P2) (car P1)))
  (setq dy ( - (cadr P2) (cadr P1)))
  (setq gocAtan (list))
  (cond
    ((and (= dx 0) (> dy 0) )
      (setq gocAtan 0)
    )
    ((and (= dx 0) (< dy 0) )
      (setq gocAtan pi)
    )
    ((and  (< dx 0) (= dy 0) )
      (setq gocAtan (/ (* 3 pi) 2))
    )
    ((and  (> dx 0) (= dy 0) )
      (setq gocAtan pi)
    )
    ((and  (= dx 0) (= dy 0) )
      (setq gocAtan 0)
    )
    ((/= dx 0)
     (progn
	(setq b (atan (/ dx dy)))
	(cond
	    ((and (> dx 0) (>= dy 0))
		  (setq gocAtan b)
	    )
	    ((and (< dx 0) (> dy 0))
		  (setq gocAtan (+ (* pi 2) b))
	    )
	    ((and (< dx 0) (< dy 0))
		  (setq gocAtan (+ pi b))
	    )
	    ((and (> dx 0) (< dy 0))
	          (setq gocAtan (+ pi b))
	    )
	)
      )
    )  
  )
  gocAtan
)
(defun styf (/ Oldtstyle Sttxt Userfont *error*)
  (defun *error* (s)
    (setvar "textstyle" oldtstyle)
  )
  (setq oldtstyle (getvar "textstyle"))
  (setq userfont "Times New Roman") 
  (setvar "textstyle" (cdr (assoc 2 (tblnext "style" T))))
  (command "._Style" "" userfont 2 1 0 "N" "N")
  (while
    (setq sttxt (cdr (assoc 2 (tblnext "style"))))
     (setvar "textstyle" sttxt)
     (command "._Style" "" userfont 2 1 0 "N" "N")
  )
  (setvar "textstyle" oldtstyle)
)


(defun daochieu (ss / count lwp ent obj oname sss revlwpl revln)
  (vl-load-com)
  (defun revlwpl(/ eo el len)
	(setq eo ent)
	(setq el (list(assoc 210 ent)))
	(while (member (assoc 10 ent) ent)
	  (if (= 0.0 (assoc 42 ent))
   (setq el (cons (assoc 42 ent) el))
   (setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
	  )
	  (setq el (cons (assoc 41 ent) el))
	  (setq el (cons (assoc 40 ent) el))
	  (setq el (cons (assoc 10 ent) el))
	  (setq ent (member (assoc 10 ent) ent))
	  (setq ent (cdr ent))
	)
	(setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
	(while (>= len 0)
	  (setq el (cons (nth len eo) el))
	  (setq len (- len 1))
	)
	(setq ent el)
	(entmod ent)
  )
  (defun revln (/ pt1 pt2)
	(setq pt1 (cons 10 (cdr (assoc 11 ent))))
	(setq pt2 (cons 11 (cdr (assoc 10 ent))))
	(setq ent (subst pt1 (assoc 10 ent) ent))
	(setq ent (subst pt2 (assoc 11 ent) ent))
	(entmod ent)
  )
	 
;;;  (princ "\nSelect Lines & Polylines to reverse direction of:   ")
;;;  (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))
  (setvar "CMDECHO" 0)
  (command "._UNDO" "_BEgin")
  (if ss
	(progn
	  (setq count 0 lwp 0)
	  (while (> (sslength ss) count)
		(setq ent (ENTGET (ssname ss count))
				  obj (vlax-ename->vla-object (ssname ss count))
				  oname (vlax-get-property obj 'ObjectName)
		)
		(cond
		  ((= oname "AcDb3dPolyline")(setq lwp(+ 1 lwp)))
		  ((= (cdadr ent) "LWPOLYLINE")(revlwpl))
		  ((= (cdadr ent) "POLYLINE")
			(progn
			  (setq sss (ssadd (ssname ss count)))
			  (vl-cmdf "convertpoly" "Light" sss "")
			  (setq ent (ENTGET (ssname sss 0)))
			  (revlwpl)
			)
		  )
		  ((= (cdadr ent) "LINE")(revln))
		)
		(setq count (+ count 1))
	  )
	)
  )
  (command "._UNDO" "_End")
  (if(> lwp 0)
	(if(> lwp 1)
	  (princ(strcat "\nCould not reverse " (itoa lwp) " 3dPolylines."))
	  (princ"\nCould not reverse the 3dPolyline.")
	)
  )
  (princ)
)

Nhưng xuất ra chỉ có một số thứ tụ, mình có file cad yêu cầu theo đó.

Mong được các bạn giúp

http://www.cadviet.com/upfiles/4/114381_hskt.rar

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

- @@, nhoc viết cho bạn lsp xuất bảng tọa độ hồi trước rùi, giờ bạn chỉ đưa bảng vào khung là xong ấy mà ^^, chỉnh cái chi cho nó phức tạp nhỉ ^^

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

ketxu
Đã đăng

Nhờ Bạn giúp mình topic này đi bạn

Mình chỉnh mãi không xong

 

- Mình k làm được, vì lisp đấy quá khó, quá dài với mình ^^. Mình chỉ hỏi bạn giữ topic nào vì 2 cái giống hệt nhau

- OK, vậy mình sẽ xóa topic kia đi. Không có cớ gì bạn lại lập hẳn 1 topic mới giống hệt topic cũ cách đây 8 tháng cả.

Thâ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
×