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  
friendship293a

Nhờ các pro sửa hộ em lisp này theo yêu cầu với ạ

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

Tot77    501

Bạn dùng cái này, theo thứ tự :

- Chọn polyline

- Chọn điểm đầu polyline

- Chọn text cao độ điểm đầu

- Chọn 3 đường giới han.

 


(defun c:test(/ li dd cd cdd 3dg x y xvt)
  (defun getVertex(v / n L)
    (setq v (vlax-ename->vla-object v)      
          n 0 L nil)
    (repeat (1- (/ (length (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates v)))) 3))
      (setq L (append L (list (vlax-safearray->list (vlax-variant-value (vla-get-Coordinate v
(setq n (1+ n)))))))))
  )  
  (defun laydxf (id v) (assoc id (entget v)))  
  (defun tb(a b) (* 0.5 (+ a b)))
  
  ;;;
  (setq li (getVertex (car (entsel "\nChon polyline:")))
dd (getpoint "\nDiem bat dau:")
cdd (atof (cdr (assoc 1 (entget (setq cd (car (entsel "\nCao do diem dau:"))))))))
  
  (if (not (equal dd (car li) 1)) (setq li (reverse li)))
 
  (princ "\nChon 3 line gioi han:")
  (setq 3dg (vl-sort (mapcar '(lambda(x) (cadr (cdr (assoc 10 (entget x)))))
 (acet-ss-to-list (ssget '((0 . "LINE"))))) '<))
  (setvar "DIMZIN" 1)
  (foreach d (cdr li)
    (setq y (+ (- (cadr d) (cadr dd)) cdd)
 xvt (car (nth (1- (vl-position d li)) li))
 x (- (car d) xvt))
    
    (entmakex (list (cons 0  "TEXT") (laydxf 8 cd)
   (cons 10 (list (car d) (cadr (dxf 10 cd))))
   (cons 11 (list (car d) (cadr (dxf 11 cd))))
   (laydxf 40 cd) (laydxf 50 cd) (laydxf 72 cd) (laydxf 73 cd) 
   (cons 1 (rtos y 2 3))))
    
    (entmakex (list (cons 0  "TEXT") (laydxf 8 cd)
   (cons 10 (list (tb (car d) xvt) (tb (car 3dg) (cadr 3dg))))
   (cons 11 (list (tb (car d) xvt) (tb (car 3dg) (cadr 3dg))))
   (laydxf 40 cd) (cons 50 (if (< x 1.5) (* 0.5 pi) 0))
   (cons 72 1) (laydxf 73 cd) 
   (cons 1 (rtos x 2 3))))
    
    (entmakex (list (cons 0 "LINE") (laydxf 8 cd)
   (cons 10 (list (car d) (car 3dg)))
   (cons 11 (list (car d) (cadr 3dg)) )))
    
    (entmakex (list (cons 0 "LINE") (laydxf 8 cd)
   (cons 10 (list (car d) (last 3dg)))
   (cons 11 (list (car d) (cadr d)) )))
   )
  (princ)
)

  • 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
hiepttr    523

Hôm qua mạng chổ mình lỗi

Giờ mới thông, lỡ rồi, up lên cho loét luôn

Cách dùng tương tự Tot77:

;Lisp lam cho y/c nay:
;;http://www.cadviet.com/forum/topic/98661-nho-cac-pro-sua-ho-em-lisp-nay-theo-yeu-cau-voi-a/
(defun c:vt( / old VAR ent pt_lst pt1 txt base_pt y1 info t_inf chenh i  h ss j lst_ygh text n)
(command "undo" "be")
(setq old (mapcar 'getvar (setq VAR '("osmode" "cmdecho" "AUNITS"))))
(mapcar 'setvar VAR '(0 0 1))
(while (not ent)
	(prompt "\nChon polynie: ")
	(setq ent (ssget "_+.:E:S" '((0 . "*POLYLINE"))))
)
(setq pt_lst (acet-geom-vertex-list (ssname ent 0)))
(setvar "osmode" 1)
(initget 1)
(setq pt1 (getpoint "\nChon diem bat dau polyline: "))
(cond
	((not 
		(or (equal pt1 (car pt_lst) 0.01)
			(equal pt1 (last pt_lst) 0.01)
		)
	)
	(prompt "\nDiem chon khong thuoc polyline _ vui long lam lai tu dau !")
	(mapcar 'setvar VAR old)
	(exit)
	)
	((not (equal pt1 (car pt_lst) 0.01))
	(setq pt_lst (reverse pt_lst)))
)
(setvar "osmode" 0)
(while (not txt)
	(prompt "\nChon text cao do diem bat dau: ")
	(setq txt (ssget "_+.:E:S" '((0 . "*TEXT"))))
)
(setq base_pt (cdr (assoc 10 (setq info (entget(ssname txt 0)))))
	y1 (atof (cdr (assoc 1 info)))
	chenh (- (cadr (car pt_lst)) y1)
	i 0)
(while (< i (1- (length pt_lst)))
	(setq h (- (cadr (nth (setq i (1+ i)) pt_lst)) chenh))
	(command ".copy" txt "" base_pt (list (car (nth i pt_lst)) (cadr base_pt)))
	(entmod (subst (cons 1 (rtos h 2 3)) (assoc 1 (setq t_inf (entget (entlast)))) t_inf))
)
(while (or (not ss) (/= 3 (sslength ss)))
	(prompt "\nChon 3 duong gioi han: ")
	(setq ss (ssget '((0 . "LINE"))))
)
(setq j 0)
(repeat 3
	(setq lst_ygh (cons (caddr (assoc 10 (entget (ssname ss j)))) lst_ygh)
		j (1+ j)
	)
)
(setq lst_ygh (vl-sort lst_ygh '<))
(foreach pt (cdr pt_lst)
	(entmake (list (cons 0 "LINE") (cons 10 pt) (list 11 (car pt) (last lst_ygh))))
	(entmake (list (cons 0 "LINE") (list 10 (car pt) (cadr lst_ygh)) (list 11 (car pt) (car lst_ygh))))
)
(setq n 0)
(repeat (1- (length pt_lst))
	(setq text (abs (- (car (nth (1+ n) pt_lst)) (car (nth n pt_lst)))))
	(command ".text" 
		"s" (cdr (assoc 7 info))
		"j" "MC"
		(list (/ (+ (car (nth n pt_lst)) (car (nth (1+ n) pt_lst))) 2.0) (/ (+ (car lst_ygh) (cadr lst_ygh)) 2.0))
		(cdr(assoc 40 info))
		(if (< text (* 4 (cdr(assoc 40 info)))) 90 0)
		(rtos text 2 3)
	)
	(setq n (1+ n))
)
(mapcar 'setvar VAR old)
(command "undo" "end")
(princ)
)

p/s: Chỉ là bài thực hành trong lúc chưa có bài học, mong đc chỉ giáo thêm !

:D :D :D

  • 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

Lisp của bác Tot77 chạy nó báo lỗi Select objects:  ; error: no function definition: DXF chả hiểu tại sao. còn lisp của bác hiệpttr thì chạy rất ok. cảm ơn các bác đã tận tình giúp đỡ, tiện thể sửa giúp em lisp của bác hiepttr thêm lựa chọn điẻm đầu vào bất kỳ mô tả như file cad em gửi được không ạ?http://www.cadviet.com/upfiles/3/1030_hoi_2_1.dwg

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êm dòng này:

 

(defun dxf (id v)  (cdr (assoc id (entget v))))

 

bên dưới dòng 

 

(defun laydxf  ....

 

Tôi quên nên xoá đi mất.

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

Bác TOT77 sửa giúp em lisp trên nốt tí các đường cao độ nó sát đường line phía trên quá nên các số như số 1 thì mất luôn vì nó trùng line bác có thể sửa cho em căn giữa như các text khoảng cách lẻ được không?

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

Phiền bạn gửi lại file dwg và lsp mới nhất, vì cũng hơi lâu rồi tôi không giữ file, gửi qua mediafire vì mấy hôm nay cadviet không up down gì được.

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  

×