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

Chèn points vào vị trí text

Bởi tnmtpc , trong AutoLisp

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

tnmtpc    207

tnmtpc
Đã đăng

Nhờ viết giúp lisp, nội dung là:

Chọn các text, Enter, -> các point sẽ tự động chèn vào từng vị trí điểm chèn của các text đã chọn (point tạo ra trên layer "points")

Thanks!

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

Tue_NV    3.912

Tue_NV
Đã đăng
Nhờ viết giúp lisp, nội dung là:

Chọn các text, Enter, -> các point sẽ tự động chèn vào từng vị trí điểm chèn của các text đã chọn (point tạo ra trên layer "points")

Thanks!

Điểm chèn text mà bạn nói có phải là chính là chế độ bắt điểm Insert của AutoCAD.

Nhưng mục đích sau cùng của bạn là gì vậy?

Bạn có thể nói rõ mục đích 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

tnmtpc    207

tnmtpc
Đã đăng
Điểm chèn text mà bạn nói có phải là chính là chế độ bắt điểm Insert của AutoCAD.

Nhưng mục đích sau cùng của bạn là gì vậy?

Bạn có thể nói rõ mục đích không?

Để trực quan hơn, mình gửi file mẫu để tham khảo, file1 trước khi dùng lisp, file2 sau khi dùng lisp. cám ơn bạn đã quan tâm

http://www.cadviet.com/upfiles/Drawing1_18.dwg

http://www.cadviet.com/upfiles/Drawing2_7.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

SONCAD    864

SONCAD
Đã đăng

Cách này chủ yếu là ðể thể hiện ðiểm ðo (Cao ðộ ) trên bình ðồ ðịa hình. Các point sẽ ðýợc chèn theo ðịnh dạng của text hiện tại (mid, left, right...). Cách của bạn dùng là ðể nội suy cao ðộ ðiểm ðo và "hợp thức hóa" chúng bằng point trên bình ðồ. Bạn có thể vào mục viết lisp theo yêu cầu ðể nhờ anh em giúp ðỡ

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

gia_bach    1.549

gia_bach
Đã đăng
Để trực quan hơn, mình gửi file mẫu để tham khảo, file1 trước khi dùng lisp, file2 sau khi dùng lisp. cám ơn bạn đã quan tâm

http://www.cadviet.com/upfiles/Drawing1_18.dwg

http://www.cadviet.com/upfiles/Drawing2_7.dwg

Bạn dùng thử LISP sau : 

(defun c:ins_point (/ ss i ent point curLayer)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") ) ; tao layer Point
     (setvar "clayer" "points")	    		     ; Set layer Current
     (repeat (sslength ss)
(setq ent (ssname ss i)
      point (cdr (assoc 10 (entget ent)))
      i	 (1+ i)
)
(entmake (list (cons 0 "POINT") (cons 10 point)))
     )
     (setvar "clayer" curLayer)
   )
 )
 (princ)
)

  • 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

vbao    80

vbao
Đã đăng
Bạn dùng thử LISP sau : 
(defun c:ins_point (/ ss i ent point curLayer)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") ) ; tao layer Point
     (setvar "clayer" "points")	    		     ; Set layer Current
     (repeat (sslength ss)
(setq ent (ssname ss i)
      point (cdr (assoc 10 (entget ent)))
      i	 (1+ i)
)
(entmake (list (cons 0 "POINT") (cons 10 point)))
     )
     (setvar "clayer" curLayer)
   )
 )
 (princ)
)

 

gia_bach có thể viết thêm đối tượng POINT vừa tạo, nếu cần theo yêu cầu của người sử dụng thì ghi thêm vào POINT có tọa độ z=giá trị của text trong tiện ích trên được không? Thanks

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

gia_bach    1.549

gia_bach
Đã đăng
gia_bach có thể viết thêm đối tượng POINT vừa tạo, nếu cần theo yêu cầu của người sử dụng thì ghi thêm vào POINT có tọa độ z=giá trị của text trong tiện ích trên được không? Thanks

Bạn dùng thử LISP sau :

(chú ý: Lisp này chưa xét đến t.hợp nội dung Text không phải là số. Vd: " 123 0" có khoảng trắng giữa các kí tự)

(defun c:ins_point (/ ss i ent point curLayer)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") ) ; tao layer Point
     (setvar "clayer" "points")	    		     ; Set layer Current
     (repeat (sslength ss)
(setq ent (ssname ss i)
      point (cdr (assoc 10 (entget ent)))
      txt (atof(cdr (assoc 1 (entget ent))))
      p (list (car point)(cadr point) txt)
      i	 (1+ i)
)
(entmake (list (cons 0 "POINT") (cons 10 p)))
     )
     (setvar "clayer" curLayer)
   )
 )
 (princ)
)

  • Like 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

gia_bach    1.549

gia_bach
Đã đăng
bạn đã chèn cao độ vào điểm node chứ ko phải là điểm insertion

muốn chèn vào điểm insertion thì có lisp nào ko bạn

Update theo yêu cầu.

Lisp chèn Point vào điểm insertion của Text (nếu có), t/hợp Text không có điểm insertion chèn Point vào điểm Node.

(chú ý: Lisp này chưa xét đến t.hợp nội dung Text không phải là số. Vd: " 123 0" có khoảng trắng giữa các kí tự)

(defun c:ins_point (/ curlayer edata i pt ss txt)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") )
     (setvar "clayer" "points")
     (repeat (sslength ss)
(setq edata (entget(ssname ss i))
      pt (if (equal (setq pt (cdr (assoc 11 edata))) '(0 0 0))
	   (cdr (assoc 10 edata))
	   pt)
      txt (atof(cdr (assoc 1 edata)))
      pt (list (car pt)(cadr pt) txt)
      i	 (1+ i)	)
(entmake (list (cons 0 "POINT") (cons 10 pt))) )
     (setvar "clayer" curLayer)  )  )
 (princ))

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

ndtnv    481

ndtnv
Đã đăng
Update theo yêu cầu.

Lisp chèn Point vào điểm insertion của Text (nếu có), t/hợp Text không có điểm insertion chèn Point vào điểm Node.

(chú ý: Lisp này chưa xét đến t.hợp nội dung Text không phải là số. Vd: " 123 0" có khoảng trắng giữa các kí tự)

(defun c:ins_point (/ curlayer edata i pt ss txt)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") )
     (setvar "clayer" "points")
     (repeat (sslength ss)
(setq edata (entget(ssname ss i))
      pt (if (equal (setq pt (cdr (assoc 11 edata))) '(0 0 0))
	   (cdr (assoc 10 edata))
	   pt)
      txt (atof(cdr (assoc 1 edata)))
      pt (list (car pt)(cadr pt) txt)
      i	 (1+ i)	)
(entmake (list (cons 0 "POINT") (cons 10 pt))) )
     (setvar "clayer" curLayer)  )  )
 (princ))

Lisp của bạn

(setq pt (if (equal (setq pt (cdr (assoc 11 edata))) '(0 0 0)) (cdr (assoc 10 edata)) pt))

ngắn hơn 1 chút so với lisp

(setq pt (cdr (assoc (if (< 0 (+ (cdr (assoc 72 edata)) (cdr (assoc 73 edata)))) 11 10) edata)))

nhưng sẽ sai trong trường hợp text có điểm chèn tại '(0 0 0) mặc dù xác suất xảy ra trong thực tế =0

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

thanhduan2407    272

thanhduan2407
Đã đăng 
(defun c:00 (/ LTSTEXT  SSTEXT)
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq Olmode (getvar "OSMODE"))
  (_layer2 "POINTS" 7)
  (setq ssText (ssget '((0 . "TEXT"))))
  (if ssText
    (Progn
      (setq LtsText (LM:ss->ent ssText))
      (foreach e LtsText
	(entmake (list (cons 0 "POINT") (cons 8 "POINTS")(cons 10 (TD:Text-Base e))))
      )
    )
  )
  (princ)
)
(defun LM:ss->ent (ss / i l)
  (if ss
    (repeat (setq i (sslength ss))
      (setq l (cons (ssname ss (setq i (1- i))) l))
    )
  )
)
(defun _layer2 (name colour)
  (if (null (tblsearch "LAYER" name))
    (entmake
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	'(70 . 0)
	(cons 2 name)
	(cons 62 colour)
      )
    )
  )
)

(defun TD:Text-Base (ent / MA71 MA72 X11)
  (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
  )
)

 

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

Người Nhà    0

Người Nhà
Đã đăng
Vào lúc 7/9/2010 tại 12:32, gia_bach đã nói:

Update theo yêu cầu.

Lisp chèn Point vào điểm insertion của Text (nếu có), t/hợp Text không có điểm insertion chèn Point vào điểm Node.

(chú ý: Lisp này chưa xét đến t.hợp nội dung Text không phải là số. Vd: " 123 0" có khoảng trắng giữa các kí tự)

  


(defun c:ins_point (/ curlayer edata i pt ss txt)
 (if (setq ss (ssget (list (cons 0 "TEXT"))))
   (progn
     (setq i 0
    curLayer (getvar "clayer"))
     (if (not (tblsearch "layer" "points"))
(command "-layer" "n" "points"  "c" "1" "points" "") )
     (setvar "clayer" "points")
     (repeat (sslength ss)
(setq edata (entget(ssname ss i))
      pt (if (equal (setq pt (cdr (assoc 11 edata))) '(0 0 0))
	   (cdr (assoc 10 edata))
	   pt)
      txt (atof(cdr (assoc 1 edata)))
      pt (list (car pt)(cadr pt) txt)
      i	 (1+ i)	)
(entmake (list (cons 0 "POINT") (cons 10 pt))) )
     (setvar "clayer" curLayer)  )  )
 (princ))
 

 

a ơi, e hỏi ngoài lề 1 chút! giả sử e muốn chèn point vào 2 đầu của line và điểm chèn lúc này là Endpoint thì e phải sửa như thế nào ạ?

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

gia_bach    1.549

gia_bach
Đã đăng
10 giờ trước, Người Nhà đã nói:

a ơi, e hỏi ngoài lề 1 chút! giả sử e muốn chèn point vào 2 đầu của line và điểm chèn lúc này là Endpoint thì e phải sửa như thế nào ạ?

Oh, chẳng phải sửa gì cả !!!

 

Viết mới lại thôi.

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
×