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

[friendship293a 10]

Lisp và yêu cầu sửa em ghi trong file cad đính kèm pro nào có thời gian giúp em với ạ. em cảm ơn nhiềuhttp://www.cadviet.com/upfiles/3/1030_cd.ls  phttp://www.cadviet.com/upfiles/3/1030_hoi_3.dwg

[hiepttr 540]

ở "kết quả" lấy đâu ra 0.5;1.5;1.5 ở hàng kc lẻ ???

[friendship293a 10]

Số đấy là khoảng cách lẻ giữa hai điểm liên tiếp đó bác

[Tot77 508]

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)

)

[hiepttr 540]

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

[friendship293a 10]

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

[Tot77 508]

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.

[friendship293a 10]

Ok cảm ơn bác thêm vào thì được hjhj. bác có thời gian thì sửa giúp em theo ý kiến comment phía trên được không?

[Tot77 508]

Cái này là lệnh mới hay sửa cái trước?

[friendship293a 10]

Sửa cái trước một chút là thành lệnh mới bác ạ hjhj

[Tot77 508]

Sửa rồi đây.

 

http://www.cadviet.com/upfiles/3/127168_tmp1_45.lsp

[friendship293a 10]

Chuẩn chỉ cần chỉnh một tí là chọn điểm lấy cao độ và chọn giá trị trước khi chọn plyline la dược hihi. giúp mình nốt nhé thanks!

[Tot77 508]

Cái đó bạn tự làm cũng được, dễ mà!! 

 

http://www.cadviet.com/upfiles/3/127168_tmp1_46.lsp

[friendship293a 10]

Ok đúng ý em rồi. cảm ơn bác đã quan tâm. em không rành lisp lắm nên chỉ biết đánh lệnh ap rồi gõ lệnh comment thui hjhj

[friendship293a 10]

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?

[Tot77 508]

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.

[friendship293a 10]

Dạ em xin gửi bác đường Link 

http://www.mediafire.com/download/iva0yqimmd8bby2/Gui+bac+Tot77.rar

[Tot77 508]

Gửi lại, nhân tiện cho text width = 0.9 luôn.

 

http://www.mediafire.com/download/38l488qlfp19fdw/h1.lsp

[friendship293a 10]

Cảm ơn bác chuẩn không phải chỉnh hjhj