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  
minhtu2004

[Yêu cầu] viết lisp vẽ Point có cao độ Z

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

minhtu2004    35

- Chào mọi người .

-Mình có 1 bản vẽ(đính kèm file cad), nhờ mọi người viết dùm code chèn point có hạ độ cao Z.

VD: trong bản vẽ có 2 Text. Text1 + Text2 = chieu cao Z can ha diem xuong.

Lenh lặp lại nhiều lần cho đến Enter hoac Esc thoat lenh. Thank moi nguoi. Mong giup do

http://www.cadviet.com/upfiles/4/35974_drawing2.dwg

 

  • Vote giảm 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    382

- ý bạn phải vậy hem ^^

(defun c:kkl (/ te1 te2 pt *error* dxf1 dxf2)
;===================================================================
 (defun *error* ( msg )
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
;==================================================================
 (while (and (setq te1 (car (entsel "\nChon text 1"))) (setq te2(car (entsel "\nChon text 2")))
(setq pt (getpoint "\nChon diem dat point :")))
;/////////////////////////////////
(setq dxf1 (cdr (assoc 1 (entget te1))) dxf2 (cdr (assoc 1 (entget te2))))
(setq caodo (- (* (distof dxf1) -1) (/ (distof dxf2) 10.0)))
(setq pt (subst caodo (last pt) pt))
(entmake (list
			(cons 0 	"POINT")
			(cons 100 	"AcDbPoint")
			(cons 10	pt)
			))
)
(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
minhtu2004    35

- Thank bạn nhiều đúng ý mình rồi. Bạn có thể chỉnh lại bao chùm toan bộ text rồi chèn vào dc hok vì trong bản vẽ dự án có tới 22500 điểm như vậy dc bố trí liên tiếp nhau như vậy và quy tắc vị trí của text giống như trong bản vẽ.

- Lúc đấu mình cũng định yều cầu như vậy do nghĩ là hok khả thi nên đổi lại yêu cầu chọn từng cặp text. Sorry bạn, nếu dc nhờ bạn chỉnh lại giúp.

http://www.cadviet.com/upfiles/4/35974_35974_drawing2.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
nhoclangbat    382

- hi lsp nhoc sữa lại cho phép chạy hàng loạt, bằng cách quét chọn các line theo như bản vẽ mẫu của bạn, cách thức của nhoc là lấy tọa độ giao điểm rùi xét từ tọa độ đó xung quang có 2 text đó ko nếu có sẽ tính ra cao độ vẽ point có cao độ, còn nếu ko có text nó vẫn vẽ lấy tọa độ giao điểm lúc đầu chưa add Z , trong file của bạn hàng cuối ko có text ^^, còn nếu ko mún vẽ khi quét chọn bạn né đường line cuối ra đừng chọn ^^.

- bạn mún xử 22k điểm chắc sợ không nổi như nhoc test khoảng 3k điểm là cad mún đơ rùi ^^, nhưng vẫn ráng đc, nên bạn chia nhỏ mà chạy, cái này nhoc chưa nghiên cứu ko pit khả năng xử lý của cad có liên quan đến khả năng của máy ko, nếu máy bạn mạnh thử test chèn 5k điểm xem ^^

(defun ss2ent (ss / i Le e) ;;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)     
(setq e (ssname ss i)        
Le (append Le (list e))        
i (1+ i)    ))
Le)
;================================================================
(defun Intersk (e1 e2 / ob1 ob2 g L i kq)(vl-load-com)
(setq ob1 (vlax-ename->vla-object e1)
    ob2 (vlax-ename->vla-object e2)    
	g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
	(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
	(setq i 0)
	(repeat (/ (length L) 3)    
	(setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))    
	(setq i (+ i 3)))
	kq)
;=================================================================
(defun c:kkl (/  *error*   ds_line old ss1 te1 te2 Lp cao_do ptn ss pcuoi pdau ssk )
;===================================================================
 (defun *error* ( msg )
        (if old (setvar 'osmode old))
        (if (not (member msg '("Function cancelled" "quit / exit abort")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq old (getvar 'osmode))
(setvar 'osmode 0)
(prompt "Chon cac doi tuong la Line : ")
(setq ss (ssget '((0 . "LINE"))))
(if ss
(progn 
;=========================
(setq ds_line (ss2ent ss))
;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
(repeat (1- (length ds_line))    
	(setq ds_line (vl-remove (setq e0 (car ds_line)) ds_line))    
	(foreach e ds_line (setq Lp (append Lp (intersk e0 e)))) 
	)
;===================================================

;/////////////////////////////////////////////////////////
(foreach k Lp
(setq pdau (mapcar '+ k '(2.35 2.35 0.0)) pcuoi (mapcar '+ k '(-2.35 -2.35 0.0)))
(if  (setq ssk   (ssget "_C" pcuoi pdau '((0 . "TEXT"))))
(progn
(setq ss1 (ss2ent ssk))
(foreach u ss1
(if (= (cdr (assoc 8 (entget u))) "S-BGD-HICN-H27")     (setq te1 (distof (cdr (assoc 1 (entget u))))))
(if (= (cdr (assoc 8 (entget u))) "S-BGD-LWCN-H27")     (setq te2 (distof (cdr (assoc 1 (entget u))))))
)
;======================================================================
;=======================================================================
(setq cao_do  (- (* te1 -1) (/ te2 10.0)))
(setq ptn (subst cao_do (last k) k))
(K_point ptn "cao_do" 3)
)
(K_point k "cao_do" 3)
)
)
;====================
) ; end progn ss
) ; end if ss
(setvar 'osmode old)
(princ "Xong")
(princ)
)
;===========================================
(defun K_point (pt layer clr / lst)
(setq lst (list '(0 . "POINT")
        '(100 . "AcDbEntity") 
        (cons 8 (if Layer Layer (getvar "Clayer")))
		    (cons 62 (if clr clr 256))
			  '(100 . "AcDbPoint")
			  (cons 10 pt)))
(entmakex lst)
)







-p/s: ah còn định dạng point bạn tự định dạng trước khi chạy hen ^^

  • 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

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  

×