Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] viết lisp đánh số các đọan thẳng?


  • Please log in to reply
49 replies to this topic

#1 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 26 June 2011 - 11:05 AM

Lúc trước e thấy 1 người làm chung sử dụng 1 lisp rất hay,e đã tìm trên diễn đàn rồi mà không thấy.Nhờ các bác viết giùm e 1 đoạn lisp như những gì trong file e gửi đính kèm phía dưới:
http://www.cadviet.c...drawing1_66.dwg
Cảm ơn các bác đã quan tâm xem và giúp đỡ.


LẦN SAU NẾU CÓ YÊU CẦU LISP THÌ PHẢI GHI RÕ NỘI DUNG. NẾU KHÔNG SẼ BỊ XÓA - BĐH
VD: Nhờ viết lisp đánh số các đọan thẳng.
  • 0

#2 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 June 2011 - 03:37 PM

Lúc trước e thấy 1 người làm chung sử dụng 1 lisp rất hay,e đã tìm trên diễn đàn rồi mà không thấy.Nhờ các bác viết giùm e 1 đoạn lisp như những gì trong file e gửi đính kèm phía dưới:
http://www.cadviet.c...drawing1_66.dwg
Cảm ơn các bác đã quan tâm xem và giúp đỡ.

Mong các bác quan tâm và giúp đỡ e với.
  • 0

#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 June 2011 - 06:33 PM

Mong các bác quan tâm và giúp đỡ e với.

Trong khi chờ đợi các bác khác giúp đỡ, bạn dùng tạm cái này :
(defun c:1(/ lstEname len lstLen i)
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0))
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '() i 1)
(foreach ent lstEname
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
(progn
(command "insert" "tt" (mid ent) 1 1 0 (rtos i 2 0))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" "tt" (mid ent) 1 1 0 (rtos (1+ (vl-position len lstLen)) 2 0))
)
)
(acet-sysvar-restore)
)
(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
)
- Lưu ý là mình test trên file của bạn thì không được, bạn thử tạo block TT lại xem sao ^^ CHúc bạn thành công :)
  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 27 June 2011 - 06:37 PM

Mong các bác quan tâm và giúp đỡ e với.


Lisp sau mình viết không biết có trúng ý của quan08 không?

(vl-load-com)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun ss2ent (ss / sodt index lstent)
(setq sodt (if ss (sslength ss) 0) index 0 lstent (list))
(repeat sodt
(setq
ent (ssname ss index)
index (1+ index)
lstent (append lstent (list ent))
)
)
(reverse lstent)
)
(defun midpline (cur) (vlax-curve-getPointAtDist cur (/ (len_cur cur) 2)))
(defun len_cur (cur) (vlax-curve-getdistatparam cur (vlax-curve-getendparam cur)))
(defun C:12(/ oldos ss lst_en index stt lis_len lis_stt_len en pt_ins len)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "*LINE"))))
(setq lst_en (ss2ent ss))
(setq lst_en (vl-sort lst_en (function (lambda (e1 e2) (<= (cadr (midpline (vlax-ename->vla-object e1))) (cadr (midpline (vlax-ename->vla-object e2))))))))
(setq index 0 stt 2 lis_len (list (setq ll0 (len_cur (vlax-ename->vla-object (nth 0 lst_en))))) lis_stt_len (list (cons ll0 1)))
(repeat (length lst_en)
(setq en (nth index lst_en))
(setq pt_ins (polar (midpline (vlax-ename->vla-object en)) (/ pi 2) 300))
(setq len (len_cur (vlax-ename->vla-object en)))
(if (= (vl-position len lis_len) nil)
(progn
(setq lis_len (append lis_len (list len)))
(setq lis_stt_len (append lis_stt_len (list (cons len stt))))
(setq stt_ex stt)
(setq stt (1+ stt))
)
(setq stt_ex (cdr (assoc len lis_stt_len)))
)
(entmake (list (cons 0 "CIRCLE") (cons 40 300) (cons 10 pt_ins)))
(entmake (list (cons 0 "TEXT") (cons 40 200) (cons 10 pt_ins) (cons 1 (itoa stt_ex)) (cons 72 4) (cons 11 pt_ins)))
(setq index (1+ index))
)
(setvar "osmode" oldos)
(princ "\nWritten by hochoaivandot - Cadviet.com!")
(princ)
)
- Mình không đưa kết quả ra block thuộc tính. Vì mình thấy không cần thiết. Vả lại nếu vậy bạn cần phải tạo thuộc tính, rồi tạo Block. Còn nếu lấy Block từ 1 file sẵn thì hay bị sai đơn vị. Mình thấy yêu cầu của bạn có thể xuất dưới dạng Text nên viết như trên.
Nếu banj vẫn muốn KQ dạng Block thuộc tính thì mình sửa cho.
- Các đối tượng chọn có thể là LINE, LWPOLYLINE, POLYLINE
  • 1

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#5 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 27 June 2011 - 06:43 PM

Mong các bác quan tâm và giúp đỡ e với.

Hề hề hề,
Chớ có nóng vội. Của bạn đây, nếu dùng chưa được thì hãy post lên nhé.

(defun C:mkatb (/ oldos col pt e1 e2 ssl plst p d n i j p1 dlst d1 d2 k k1 ss1)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
(if (tblsearch "block" "test")
(progn
(setq ten (getstring t "\n Nhap ten block moi: "))
(command "rename" "b" "test" ten)
)
)
(command "block" "test" pt e1 e2 "" )
(alert "\n Chon tap doi tuong doan thang")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst (list))
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
)

(setq n (length plst)
i 0
j 1
p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" "" (rtos j 2 0) )
(setq dlst (list)
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" "" (rtos (1+ k1) 2 0) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" "" (rtos (setq j (1+ j)) 2 0) )
)
)
(setq i (1+ i))
)
(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Đã test thử với bản vẽ bạn gửi bao gồm có lwpolyline và line thì Ok. Còn với polyline thì chửa test. Bạn hãy tự test nhé.
Dù là lwpolyline hay polyline thì cái điểm đặt block sẽ nằm cách điểm giữa của phân đoạn thứ nhất một khoảng là 300 theo phuong y. Đồng thời nó sẽ so sánh độ dài của phân đoạn này để đánh số thứ tự chứ hổng phải tổng chiều dài đâu nhé.
Cái block đánh số này mình thiết kế theo mẫu của bạn gửi nhưng không phải là có tên là TT mà tên là test với thuộc tính là tt cho phép người dùng nhập giá trị.
cái block tt của bạn tuy cũng có thuộc tính nhưng đó là thuộc tính chết chứ người dùng không thể thay đổi giá trị thuộc tính được. bởi vậy nên mình không dùng cho lisp này.
Hy vọng bạn hết bức xúc hỉ.....
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#6 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 June 2011 - 07:16 PM

Trong khi chờ đợi các bác khác giúp đỡ, bạn dùng tạm cái này :

(defun c:1(/ lstEname len lstLen i)
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0))
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '() i 1)
(foreach ent lstEname
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
(progn
(command "insert" "tt" (mid ent) 1 1 0 (rtos i 2 0))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" "tt" (mid ent) 1 1 0 (rtos (1+ (vl-position len lstLen)) 2 0))
)
)
(acet-sysvar-restore)
)
(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
)
- Lưu ý là mình test trên file của bạn thì không được, bạn thử tạo block TT lại xem sao ^^ CHúc bạn thành công :)

Không cần phải giống block att trong file,e chỉ cần nó đánh số như yêu cầu,xong tự động cho số và vòng tròn đó là block thuộc tính là được bác ah.
  • 0

#7 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 June 2011 - 07:21 PM

Lisp sau mình viết không biết có trúng ý của quan08 không?


(vl-load-com)
(defun dxf (code e) (cdr (assoc code (entget e))))
(defun ss2ent (ss / sodt index lstent)
(setq sodt (if ss (sslength ss) 0) index 0 lstent (list))
(repeat sodt
(setq
ent (ssname ss index)
index (1+ index)
lstent (append lstent (list ent))
)
)
(reverse lstent)
)
(defun midpline (cur) (vlax-curve-getPointAtDist cur (/ (len_cur cur) 2)))
(defun len_cur (cur) (vlax-curve-getdistatparam cur (vlax-curve-getendparam cur)))
(defun C:12(/ oldos ss lst_en index stt lis_len lis_stt_len en pt_ins len)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ss (ssget '((0 . "*LINE"))))
(setq lst_en (ss2ent ss))
(setq lst_en (vl-sort lst_en (function (lambda (e1 e2) (<= (cadr (midpline (vlax-ename->vla-object e1))) (cadr (midpline (vlax-ename->vla-object e2))))))))
(setq index 0 stt 2 lis_len (list (setq ll0 (len_cur (vlax-ename->vla-object (nth 0 lst_en))))) lis_stt_len (list (cons ll0 1)))
(repeat (length lst_en)
(setq en (nth index lst_en))
(setq pt_ins (polar (midpline (vlax-ename->vla-object en)) (/ pi 2) 300))
(setq len (len_cur (vlax-ename->vla-object en)))
(if (= (vl-position len lis_len) nil)
(progn
(setq lis_len (append lis_len (list len)))
(setq lis_stt_len (append lis_stt_len (list (cons len stt))))
(setq stt_ex stt)
(setq stt (1+ stt))
)
(setq stt_ex (cdr (assoc len lis_stt_len)))
)
(entmake (list (cons 0 "CIRCLE") (cons 40 300) (cons 10 pt_ins)))
(entmake (list (cons 0 "TEXT") (cons 40 200) (cons 10 pt_ins) (cons 1 (itoa stt_ex)) (cons 72 4) (cons 11 pt_ins)))
(setq index (1+ index))
)
(setvar "osmode" oldos)
(princ "\nWritten by hochoaivandot - Cadviet.com!")
(princ)
)
- Mình không đưa kết quả ra block thuộc tính. Vì mình thấy không cần thiết. Vả lại nếu vậy bạn cần phải tạo thuộc tính, rồi tạo Block. Còn nếu lấy Block từ 1 file sẵn thì hay bị sai đơn vị. Mình thấy yêu cầu của bạn có thể xuất dưới dạng Text nên viết như trên.
Nếu banj vẫn muốn KQ dạng Block thuộc tính thì mình sửa cho.
- Các đối tượng chọn có thể là LINE, LWPOLYLINE, POLYLINE

Bạn đã giúp đỡ đúng ý mình,nhưng mình cần sau khi đánh số thì nó tự động tạo chữ và vòng tròn thành 1 block thuộc tính,bạn thêm giùm mình nhé.Tiện thể bạn thêm chức năng:hiện lisp đang đánh số các đường thẳng theo phương x,Vậy khi các đường thẳng theo phương y thì mình muốn cũng đánh được số và cái block att đó cũng nằm ngang,giống như mình xoay cái theo phương X 90độ và đánh từ trái qua phải.Thanks.
http://www.cadviet.c.../drawing111.dwg
  • 0

#8 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 June 2011 - 07:37 PM

Hề hề hề,
Chớ có nóng vội. Của bạn đây, nếu dùng chưa được thì hãy post lên nhé.


(defun C:mkatb (/ oldos col pt e1 e2 ssl plst p d n i j p1 dlst d1 d2 k k1 ss1)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
(if (tblsearch "block" "test")
(progn
(setq ten (getstring t "\n Nhap ten block moi: "))
(command "rename" "b" "test" ten)
)
)
(command "block" "test" pt e1 e2 "" )
(alert "\n Chon tap doi tuong doan thang")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst (list))
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
)

(setq n (length plst)
i 0
j 1
p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" "" (rtos j 2 0) )
(setq dlst (list)
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" "" (rtos (1+ k1) 2 0) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" "" (rtos (setq j (1+ j)) 2 0) )
)
)
(setq i (1+ i))
)
(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Đã test thử với bản vẽ bạn gửi bao gồm có lwpolyline và line thì Ok. Còn với polyline thì chửa test. Bạn hãy tự test nhé.
Dù là lwpolyline hay polyline thì cái điểm đặt block sẽ nằm cách điểm giữa của phân đoạn thứ nhất một khoảng là 300 theo phuong y. Đồng thời nó sẽ so sánh độ dài của phân đoạn này để đánh số thứ tự chứ hổng phải tổng chiều dài đâu nhé.
Cái block đánh số này mình thiết kế theo mẫu của bạn gửi nhưng không phải là có tên là TT mà tên là test với thuộc tính là tt cho phép người dùng nhập giá trị.
cái block tt của bạn tuy cũng có thuộc tính nhưng đó là thuộc tính chết chứ người dùng không thể thay đổi giá trị thuộc tính được. bởi vậy nên mình không dùng cho lisp này.
Hy vọng bạn hết bức xúc hỉ.....

E đã test với polyline ok rồi,nhưng bác bỏ giùm e chức năng nhập điểm chuẩn tạo block mới.Chỉ cần chọn đối tượng đánh số thứ tự và tạo chữ với vòng tròn thành 1 block thuộc tính là được bác ạ.Bác xem giùm e thêm trường hợp này với nếu các đường thẳng theo phuong y thì các block att này tự động xoay ngang luôn,Nếu đoạn thẳng theo phương X thì đánh từ dưới lên trên,còn theo phương Y thì từ trái qua phải.Cảm ơn bác.e có gửi file đính kèm.
http://www.cadviet.c.../drawing111.dwg
  • 0

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 27 June 2011 - 08:19 PM

E đã test với polyline ok rồi,nhưng bác bỏ giùm e chức năng nhập điểm chuẩn tạo block mới.Chỉ cần chọn đối tượng đánh số thứ tự và tạo chữ với vòng tròn thành 1 block thuộc tính là được bác ạ.Bác xem giùm e thêm trường hợp này với nếu các đường thẳng theo phuong y thì các block att này tự động xoay ngang luôn,Nếu đoạn thẳng theo phương X thì đánh từ dưới lên trên,còn theo phương Y thì từ trái qua phải.Cảm ơn bác.e có gửi file đính kèm.
http://www.cadviet.c.../drawing111.dwg

Hề hề hề,
Về các yêu cầu bổ sung của bạn:
1/- Không nên bỏ chức năng này vì việc tạo block phải cần tới điểm chuẩn của block. Nếu bạn không chọn điểm mà để lisp tự lấy một điểm trên bản vẽ sẽ rất dễ bị trùng vào các đối tượng khác bạn ạ và bạn sẽ không thể kiểm tra được nó. Còn nếu bạn vẫn cứ muốn bỏ thì hãy tự thay dòng code:
(setq pt (getpoint "\n Chon diem chuan"))
thành dòng code:
(setq pt (list 0 0 0))
2/- Mình bổ sung cho bạn thêm phương án chọn lựa là đánh số theo phương x hay phương y. Nếu bạn chọn phương y thì lisp sẽ xoay block 90 độ và đánh số theo trật tự từ trái qua phải (chứ không phải từ phải qua trái như cái hình bạn post đâu nhé). Còn nếu bạn chọn phương x hay đúng hơn là không chọn phương y, thì lisp sẽ mặc định là phương x và làm nguyên như cũ tức là đánh số từ dưới lên trên. Như vậy tùy ý bạn sử dụng sao cho sướng con mắt bên phải, lé con mắt bên trái là được. Hề hề hề.

(defun C:mkatb (/ oldos col pt e1 e2 ssl plst p d n i j p1 dlst d1 d2 k k1 ss1)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
(if (tblsearch "block" "test")
(progn
(setq ten (getstring t "\n Nhap ten block moi: "))
(command "rename" "b" "test" ten)
)
)
(command "block" "test" pt e1 e2 "" )
(alert "\n Chon tap doi tuong doan thang")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst (list))
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
(if (= (strcase ans) "Y")
(progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
)
(progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
)
)

(setq n (length plst)
i 0
j 1
p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (rtos j 2 0) )
(setq dlst (list)
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (rtos (1+ k1) 2 0) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (rtos (setq j (1+ j)) 2 0) )
)
)
(setq i (1+ i))
)
(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(if (= (strcase ans) "Y")
(command "move" ss1 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Vì mình làm vội nên lisp chưa trau chuốt lắm và hơi lủng củng, nếu bạn muốn có thể tự chỉnh lại cho nó hợp lý hơn.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#10 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 June 2011 - 09:17 PM

Hề hề hề,
Về các yêu cầu bổ sung của bạn:
1/- Không nên bỏ chức năng này vì việc tạo block phải cần tới điểm chuẩn của block. Nếu bạn không chọn điểm mà để lisp tự lấy một điểm trên bản vẽ sẽ rất dễ bị trùng vào các đối tượng khác bạn ạ và bạn sẽ không thể kiểm tra được nó. Còn nếu bạn vẫn cứ muốn bỏ thì hãy tự thay dòng code:
(setq pt (getpoint "\n Chon diem chuan"))
thành dòng code:
(setq pt (list 0 0 0))
2/- Mình bổ sung cho bạn thêm phương án chọn lựa là đánh số theo phương x hay phương y. Nếu bạn chọn phương y thì lisp sẽ xoay block 90 độ và đánh số theo trật tự từ trái qua phải (chứ không phải từ phải qua trái như cái hình bạn post đâu nhé). Còn nếu bạn chọn phương x hay đúng hơn là không chọn phương y, thì lisp sẽ mặc định là phương x và làm nguyên như cũ tức là đánh số từ dưới lên trên. Như vậy tùy ý bạn sử dụng sao cho sướng con mắt bên phải, lé con mắt bên trái là được. Hề hề hề.


(defun C:mkatb (/ oldos col pt e1 e2 ssl plst p d n i j p1 dlst d1 d2 k k1 ss1)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
(if (tblsearch "block" "test")
(progn
(setq ten (getstring t "\n Nhap ten block moi: "))
(command "rename" "b" "test" ten)
)
)
(command "block" "test" pt e1 e2 "" )
(alert "\n Chon tap doi tuong doan thang")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst (list))
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
(if (= (strcase ans) "Y")
(progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
)
(progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
)
)

(setq n (length plst)
i 0
j 1
p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (rtos j 2 0) )
(setq dlst (list)
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (rtos (1+ k1) 2 0) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (rtos (setq j (1+ j)) 2 0) )
)
)
(setq i (1+ i))
)
(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(if (= (strcase ans) "Y")
(command "move" ss1 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Vì mình làm vội nên lisp chưa trau chuốt lắm và hơi lủng củng, nếu bạn muốn có thể tự chỉnh lại cho nó hợp lý hơn.

Thành thật xin lỗi bác nó vẫn chưa đúng ý e bác ạ.E thấy nếu đánh số rồi,đánh lệnh đánh tiếp có dòng kêu nhập tên block mới,nếu nhập tên khác nó vẫn lấy block cũ để đánh mới.Bác có thể bỏ dòng nhập tên block mới đi giùm e vì e thấy vẫn để tên block cũ đánh tiếp là được rồi.Còn đánh theo X,Y ý e lại khác.E gửi file đính kèm bác xem giúp e thêm lần nữa.Cảm ơn bác nhiều.
http://www.cadviet.c...rawing111_1.dwg
  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 June 2011 - 09:18 PM

Không cần phải giống block att trong file,e chỉ cần nó đánh số như yêu cầu,xong tự động cho số và vòng tròn đó là block thuộc tính là được bác ah.



Bạn đã giúp đỡ đúng ý mình,nhưng mình cần sau khi đánh số thì nó tự động tạo chữ và vòng tròn thành 1 block thuộc tính,bạn thêm giùm mình nhé.Tiện thể bạn thêm chức năng:hiện lisp đang đánh số các đường thẳng theo phương x,Vậy khi các đường thẳng theo phương y thì mình muốn cũng đánh được số và cái block att đó cũng nằm ngang,giống như mình xoay cái theo phương X 90độ và đánh từ trái qua phải.Thanks.
http://www.cadviet.c.../drawing111.dwg



E đã test với polyline ok rồi,nhưng bác bỏ giùm e chức năng nhập điểm chuẩn tạo block mới.Chỉ cần chọn đối tượng đánh số thứ tự và tạo chữ với vòng tròn thành 1 block thuộc tính là được bác ạ.Bác xem giùm e thêm trường hợp này với nếu các đường thẳng theo phuong y thì các block att này tự động xoay ngang luôn,Nếu đoạn thẳng theo phương X thì đánh từ dưới lên trên,còn theo phương Y thì từ trái qua phải.Cảm ơn bác.e có gửi file đính kèm.
http://www.cadviet.c.../drawing111.dwg


@quan08 : theo như hình bạn mô tả thì Pline của bạn chỉ là các PLine 1 phân đoạn, và chỉ có đúng 1 phương : hoặc đứng, hoặc ngang ?
Mình không thích cách bạn quá phụ thuộc vào lisp, đến cái Block ghi STT bạn cũng ngại làm, vậy thì làm sao nó làm đúng ý bạn được ? Mà nếu đã để lisp tự làm hết thế thì quan trọng gì nó là Block thuộc tính hay chữ + vòng tròn ?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 27 June 2011 - 09:44 PM

@quan08 : theo như hình bạn mô tả thì Pline của bạn chỉ là các PLine 1 phân đoạn, và chỉ có đúng 1 phương : hoặc đứng, hoặc ngang ?
Mình không thích cách bạn quá phụ thuộc vào lisp, đến cái Block ghi STT bạn cũng ngại làm, vậy thì làm sao nó làm đúng ý bạn được ? Mà nếu đã để lisp tự làm hết thế thì quan trọng gì nó là Block thuộc tính hay chữ + vòng tròn ?

Không bạn ah,vừa có đứng và ngang luôn.Block ghi STT mình đã làm thử theo lisp của bạn nhưng nó nằm chưa đúng,vòng tròn phải nằm trên pl,thấy lisp bác bình tạo nằm đúng vị trí nên mình nhờ bác ấy giúp.Chân thành cảm ơn lời góp ý chân thành của bạn.Mong sau này nhận được nhiều nhận xét và sự giúp đỡ của bạn.
  • 0

#13 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 June 2011 - 10:01 PM

Không bạn ah,vừa có đứng và ngang luôn.Block ghi STT mình đã làm thử theo lisp của bạn nhưng nó nằm chưa đúng,vòng tròn phải nằm trên pl,thấy lisp bác bình tạo nằm đúng vị trí nên mình nhờ bác ấy giúp.Chân thành cảm ơn lời góp ý chân thành của bạn.Mong sau này nhận được nhiều nhận xét và sự giúp đỡ của bạn.

Bạn không để ý là khi dùng lệnh Insert thì CAD sẽ lấy InsertPoint của Block để làm điểm chèn ? Có thể nói là bạn chưa biết cách tạo Block chứ không phải lý do do cách hành xử của Lisp.
Lisp bác Bình viết chèn Block vào chân Pline, sau đó ssget để đẩy Block tách ra khỏi Pline!
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#14 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 02:37 AM

Thành thật xin lỗi bác nó vẫn chưa đúng ý e bác ạ.E thấy nếu đánh số rồi,đánh lệnh đánh tiếp có dòng kêu nhập tên block mới,nếu nhập tên khác nó vẫn lấy block cũ để đánh mới.Bác có thể bỏ dòng nhập tên block mới đi giùm e vì e thấy vẫn để tên block cũ đánh tiếp là được rồi.Còn đánh theo X,Y ý e lại khác.E gửi file đính kèm bác xem giúp e thêm lần nữa.Cảm ơn bác nhiều.
http://www.cadviet.c...rawing111_1.dwg

Hề hề hề,
Bạn cần rút kinh nghiệm, hãy suy nghĩ thấu đáo các vấn đề có liuên quan rồi hãy post yêu cầu nhé.
Thực ra cái yêu cầu của bạn không quá khó nhưng bạn đặt vấn đề không rõ ràng nên làm cho vấn đề phức tạp lên.
Bạn nên đọc thêm về các vấn đề có liên quan tới block thuộc tính và tìm hiểu thêm về lisp để có thể đọc và hiểu được cái lisp nói gì.
Thực ra bạn không hiểu cái lisp mình viết nên mới có những phát biểu chưa chuẩn.
Khi lisp yêu cầu bạn Nhap ten block moi ở đây là bạn nhập tên mới cho cái block "test" đã có sẵn trên bản vẽ của bạn để đổi tên cái block đó đi. Bởi vì mình không biết cái block tên test đó của bạn có thực sự phù hợp với cái block thuộc tính test mà mình sẽ tạo ra trong lisp để điền vào các vị trí bạn cần. Vì thế mình cứ đổi tên chúng đi thành tên mới do bạn chọn để bạn có thể sử dụng lại sau này nếu cần thiết.
Còn cái block thuộc tính test mình sẽ tạo mới nó và dùng cho lisp của mình để đảm bảo hoàn toàn các yêu cầu đặt ra trong lisp bạn ạ.
Vậy nên việc bạn yêu cầu phải bỏ điểm nhập cũng như bỏ cái việc nhập tên mới là không thể chiều bạn được
Lisp chỉ yêu cầu bạn nhập tên mới khi trên bản vẽ của bạn đã có block tên test mà thôi, còn nếu chưa có nó sẽ tự tạo ra block test.
Và đây là cái mình đã cố để hiểu cái yêu cầu của bạn và làm thử. bạn dùng xem có ý kiến gì ta sẽ trao đổi tiếp nhé.

(defun C:mkatb (/ oldos col pt e1 e2 ten plst plst1 dlst j j1 i i1 n n1 m ssl ssl1 p p1 d d1 d2 k k1 ss1 ss2 ss3 goc)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
(if (tblsearch "block" "test")
(progn
(setq ten (getstring t "\n Nhap ten block moi: "))
(command "rename" "b" "test" ten)
)
)
(command "block" "test" pt e1 e2 "" )
(setq plst (list)
dlst (list)
j (getint "\n Nhap gia tri so bat dau danh so: ")
m (getstring t "\n Nhap cac ky tu di kem: ")
)
(alert "\n Chon tap doi tuong doan thang theo phuong x")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq j1 j)
(if ssl
(progn
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
;;;;;;;;(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
;;;;;;;;(if (= (strcase ans) "Y")
;;;;;;; (progn
;;;;;;; (setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
;;;;;;; (setq goc "90")
;;;;;;; )
;;;;;;; (progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
;;;;;;; )
;;;;;;;)

(setq n (length plst)
i 0

p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (strcat (rtos j 2 0) m) )
(setq
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i (1+ i))
)
)
(setq j (1- j))
)

(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))

(alert "\n Chon tap doi tuong doan thang theo phuong y")
(setq ssl1 (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst1 (list))
(if ssl1
(progn
(foreach x ssl1
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst1 (append plst1 (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst1 (append plst1 (list (list p d)))
)
)
)
(setq plst1 (vl-sort plst1 '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
(setq n1 (length plst1)
i1 0)
(while (< i1 n1)
(setq d2 (cadr (nth i1 plst1)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth i1 plst1)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth i1 plst1)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i1 (1+ i1))
)
)
)

(setq ss2 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(setq ss3 (ACET-SS-REMOVE ss1 ss2))


;;;;;(if (= (strcase ans) "Y")
(command "move" ss3 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
;;;;;;)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Hy vọng bạn hài lòng. Lisp này có thể đáp ứng đủ những yêu cầu mà bạn đã nêu ra, kể cả trường hợp số có chữ đi kèm. Nếu không muốn số có kèm theo text thì khi lisp yêu cầu bạn nhap cac ky tu di kem bạn cứ nhấn enter để bỏ qua. Nếu bạn không muốn đánh số cho các line ngang thì khi lisp yêu cầu bạn Chon tap cac doan thang theo phương x bạn nhấn enter hai lần để bỏ qua việc chọn này và lisp sẽ yêu cầu bạn chon tap cac doan thang thep phuong y.
Chúc bạn vui.
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#15 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 June 2011 - 05:43 AM

Hề hề hề,
Bạn cần rút kinh nghiệm, hãy suy nghĩ thấu đáo các vấn đề có liuên quan rồi hãy post yêu cầu nhé.
Thực ra cái yêu cầu của bạn không quá khó nhưng bạn đặt vấn đề không rõ ràng nên làm cho vấn đề phức tạp lên.
Bạn nên đọc thêm về các vấn đề có liên quan tới block thuộc tính và tìm hiểu thêm về lisp để có thể đọc và hiểu được cái lisp nói gì.
Thực ra bạn không hiểu cái lisp mình viết nên mới có những phát biểu chưa chuẩn.
Khi lisp yêu cầu bạn Nhap ten block moi ở đây là bạn nhập tên mới cho cái block "test" đã có sẵn trên bản vẽ của bạn để đổi tên cái block đó đi. Bởi vì mình không biết cái block tên test đó của bạn có thực sự phù hợp với cái block thuộc tính test mà mình sẽ tạo ra trong lisp để điền vào các vị trí bạn cần. Vì thế mình cứ đổi tên chúng đi thành tên mới do bạn chọn để bạn có thể sử dụng lại sau này nếu cần thiết.
Còn cái block thuộc tính test mình sẽ tạo mới nó và dùng cho lisp của mình để đảm bảo hoàn toàn các yêu cầu đặt ra trong lisp bạn ạ.
Vậy nên việc bạn yêu cầu phải bỏ điểm nhập cũng như bỏ cái việc nhập tên mới là không thể chiều bạn được
Lisp chỉ yêu cầu bạn nhập tên mới khi trên bản vẽ của bạn đã có block tên test mà thôi, còn nếu chưa có nó sẽ tự tạo ra block test.
Và đây là cái mình đã cố để hiểu cái yêu cầu của bạn và làm thử. bạn dùng xem có ý kiến gì ta sẽ trao đổi tiếp nhé.


(defun C:mkatb (/ oldos col pt e1 e2 ten plst plst1 dlst j j1 i i1 n n1 m ssl ssl1 p p1 d d1 d2 k k1 ss1 ss2 ss3 goc)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
(if (tblsearch "block" "test")
(progn
(setq ten (getstring t "\n Nhap ten block moi: "))
(command "rename" "b" "test" ten)
)
)
(command "block" "test" pt e1 e2 "" )
(setq plst (list)
dlst (list)
j (getint "\n Nhap gia tri so bat dau danh so: ")
m (getstring t "\n Nhap cac ky tu di kem: ")
)
(alert "\n Chon tap doi tuong doan thang theo phuong x")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq j1 j)
(if ssl
(progn
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
;;;;;;;;(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
;;;;;;;;(if (= (strcase ans) "Y")
;;;;;;; (progn
;;;;;;; (setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
;;;;;;; (setq goc "90")
;;;;;;; )
;;;;;;; (progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
;;;;;;; )
;;;;;;;)

(setq n (length plst)
i 0

p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (strcat (rtos j 2 0) m) )
(setq
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i (1+ i))
)
)
(setq j (1- j))
)

(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))

(alert "\n Chon tap doi tuong doan thang theo phuong y")
(setq ssl1 (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst1 (list))
(if ssl1
(progn
(foreach x ssl1
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst1 (append plst1 (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst1 (append plst1 (list (list p d)))
)
)
)
(setq plst1 (vl-sort plst1 '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
(setq n1 (length plst1)
i1 0)
(while (< i1 n1)
(setq d2 (cadr (nth i1 plst1)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth i1 plst1)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth i1 plst1)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i1 (1+ i1))
)
)
)

(setq ss2 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(setq ss3 (ACET-SS-REMOVE ss1 ss2))


;;;;;(if (= (strcase ans) "Y")
(command "move" ss3 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
;;;;;;)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Hy vọng bạn hài lòng. Lisp này có thể đáp ứng đủ những yêu cầu mà bạn đã nêu ra, kể cả trường hợp số có chữ đi kèm. Nếu không muốn số có kèm theo text thì khi lisp yêu cầu bạn nhap cac ky tu di kem bạn cứ nhấn enter để bỏ qua. Nếu bạn không muốn đánh số cho các line ngang thì khi lisp yêu cầu bạn Chon tap cac doan thang theo phương x bạn nhấn enter hai lần để bỏ qua việc chọn này và lisp sẽ yêu cầu bạn chon tap cac doan thang thep phuong y.
Chúc bạn vui.

Rất cám ơn bác đã thức khuya viết cho e.Lisp rất OK nhưng e còn 2 vấn đề muốn nhờ bác sửa giùm:
-Thay vì hiện bảng :Chon tap doi tuong doan thang theo phuong x enter rồi mới select objects.E muốn bỏ qua công đoạn hiện :Chon tap doi tuong doan thang theo phuon x mà hiện select objects X dir rồi chọn đối tượng phương X,tương tự phương Y cũng vậy.
-E muốn khi đánh các đoạn thẳng khác vẫn lấy tên block cũ đã đánh trước đó không cần đổi tên có được không bác?Chứ trong bản vẽ mỗi lần đánh số lại tạo ra 1 block khác nhau thì khó kiểm soát và nặng bản vẽ lắm bác ạ.
  • 0

#16 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 02:20 PM

Rất cám ơn bác đã thức khuya viết cho e.Lisp rất OK nhưng e còn 2 vấn đề muốn nhờ bác sửa giùm:
-Thay vì hiện bảng :Chon tap doi tuong doan thang theo phuong x enter rồi mới select objects.E muốn bỏ qua công đoạn hiện :Chon tap doi tuong doan thang theo phuon x mà hiện select objects X dir rồi chọn đối tượng phương X,tương tự phương Y cũng vậy.
-E muốn khi đánh các đoạn thẳng khác vẫn lấy tên block cũ đã đánh trước đó không cần đổi tên có được không bác?Chứ trong bản vẽ mỗi lần đánh số lại tạo ra 1 block khác nhau thì khó kiểm soát và nặng bản vẽ lắm bác ạ.

Hề hề hề,
Bạn thật là ?????????
Mình đã sửa theo ý bạn song mình sẽ không chịu trách nhiệm sửa nữa nếu như trên bản vẽ của bạn có sẵn một block tên test mà không đúng với cái block thuộc tính bạn yêu cầu. Khi đó nếu bạn muốn sửa thì hãy tự sửa nhé vì mình vẫn để các dòng code cũ lại chỉ vô hiệu hóa chúng mà thôi.
Hy vọng bạn sẽ không còn thắc mắc nữa....

(defun C:mkatb (/ oldos col pt e1 e2 ten plst plst1 dlst j j1 i i1 n n1 m ssl ssl1 p p1 d d1 d2 k k1 ss1 ss2 ss3 goc)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "angdir" 0)
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(if (not (tblsearch "block" "test"))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
;;;;;;;;(if (tblsearch "block" "test")
;;;;;;;; (progn
;;;;;;;; (setq ten (getstring t "\n Nhap ten block moi: "))
;;;;;;;; (command "rename" "b" "test" ten)
;;;;;;;; )
;;;;;;;;)
(command "block" "test" pt e1 e2 "" )
)
)
(setq plst (list)
dlst (list)
j (getint "\n Nhap gia tri so bat dau danh so: ")
m (getstring t "\n Nhap cac ky tu di kem: ")
)
(prompt "\n Chon tap doi tuong doan thang theo phuong x")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq j1 j)
(if ssl
(progn
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
;;;;;;;;(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
;;;;;;;;(if (= (strcase ans) "Y")
;;;;;;; (progn
;;;;;;; (setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
;;;;;;; (setq goc "90")
;;;;;;; )
;;;;;;; (progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
;;;;;;; )
;;;;;;;)

(setq n (length plst)
i 0

p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (strcat (rtos j 2 0) m) )
(setq
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i (1+ i))
)
)
(setq j (1- j))
)

(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))

(prompt "\n Chon tap doi tuong doan thang theo phuong y")
(setq ssl1 (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst1 (list))
(if ssl1
(progn
(foreach x ssl1
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst1 (append plst1 (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst1 (append plst1 (list (list p d)))
)
)
)
(setq plst1 (vl-sort plst1 '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
(setq n1 (length plst1)
i1 0)
(while (< i1 n1)
(setq d2 (cadr (nth i1 plst1)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth i1 plst1)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth i1 plst1)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i1 (1+ i1))
)
)
)

(setq ss2 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(setq ss3 (ACET-SS-REMOVE ss1 ss2))


;;;;;(if (= (strcase ans) "Y")
(command "move" ss3 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
;;;;;;)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 29 June 2011 - 12:59 AM
Bổ sung lisp theo góp ý của bác ketxu

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#17 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 June 2011 - 02:37 PM

Hề hề hề,
Bạn thật là ?????????
Mình đã sửa theo ý bạn song mình sẽ không chịu trách nhiệm sửa nữa nếu như trên bản vẽ của bạn có sẵn một block tên test mà không đúng với cái block thuộc tính bạn yêu cầu. Khi đó nếu bạn muốn sửa thì hãy tự sửa nhé vì mình vẫn để các dòng code cũ lại chỉ vô hiệu hóa chúng mà thôi.
Hy vọng bạn sẽ không còn thắc mắc nữa....


(defun C:mkatb (/ oldos col pt e1 e2 ten plst plst1 dlst j j1 i i1 n n1 m ssl ssl1 p p1 d d1 d2 k k1 ss1 ss2 ss3 goc)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setq col (getvar "cecolor"))
(setvar "angdir" 0)
(setq pt (getpoint "\n Chon diem chuan"))
(setvar "osmode" 0)
(setvar "cecolor" "4")
(if (not (tblsearch "block" "test"))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" pt "250" "0" )
(setq e1 (entlast))
(setvar "cecolor" col)
(command "circle" pt 300)
(setq e2 (entlast))
;;;;;;;;(if (tblsearch "block" "test")
;;;;;;;; (progn
;;;;;;;; (setq ten (getstring t "\n Nhap ten block moi: "))
;;;;;;;; (command "rename" "b" "test" ten)
;;;;;;;; )
;;;;;;;;)
(command "block" "test" pt e1 e2 "" )
)
)
(setq plst (list)
dlst (list)
j (getint "\n Nhap gia tri so bat dau danh so: ")
m (getstring t "\n Nhap cac ky tu di kem: ")
)
(prompt "\n Chon tap doi tuong doan thang theo phuong x")
(setq ssl (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq j1 j)
(if ssl
(progn
(foreach x ssl
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst (append plst (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst (append plst (list (list p d)))
)
)
)
;;;;;;;;(setq ans (getstring t "\n Ban muon danh so theo phuong nao? <X or Y>: "))
;;;;;;;;(if (= (strcase ans) "Y")
;;;;;;; (progn
;;;;;;; (setq plst (vl-sort plst '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
;;;;;;; (setq goc "90")
;;;;;;; )
;;;;;;; (progn
(setq plst (vl-sort plst '(lambda (y1 y2) (< (cadr (car y1)) (cadr (car y2))))))
(setq goc "")
;;;;;;; )
;;;;;;;)

(setq n (length plst)
i 0

p1 (car (nth i plst))
)
(command "insert" "test" p1 "" "" goc (strcat (rtos j 2 0) m) )
(setq
d1 (cadr (nth i plst))
dlst (cons d1 dlst))
(while (< i (1- n))
(setq d2 (cadr (nth (1+ i) plst)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth (1+ i) plst)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth (1+ i) plst)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i (1+ i))
)
)
(setq j (1- j))
)

(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))

(prompt "\n Chon tap doi tuong doan thang theo phuong y")
(setq ssl1 (acet-ss-to-list (ssget (list (cons 0 "*line")))))
(setq plst1 (list))
(if ssl1
(progn
(foreach x ssl1
(if (/= (cdr (assoc 0 (entget x))) "LINE")
(setq p (vlax-curve-getpointatparam (vlax-ename->vla-object x) 0.5)
d (vlax-curve-getdistatparam (vlax-ename->vla-object x) 1)
plst1 (append plst1 (list (list p d)))
)
(setq p (acet-geom-midpoint (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
d (distance (cdr (assoc 10 (entget x))) (cdr (assoc 11 (entget x))))
plst1 (append plst1 (list (list p d)))
)
)
)
(setq plst1 (vl-sort plst1 '(lambda (y1 y2) (< (car (car y1)) (car (car y2))))))
(setq goc "90")
(setq n1 (length plst1)
i1 0)
(while (< i1 n1)
(setq d2 (cadr (nth i1 plst1)))

(if (setq k (vl-position d2 dlst))
(progn
(setq k1 (vl-position d2 (reverse dlst)))
(setq p1 (car (nth i1 plst1)))
(command "insert" "test" p1 "" "" goc (strcat (rtos (+ k1 j1) 2 0) m) )
)
(progn
(setq dlst (cons d2 dlst))
(command "insert" "test" (car (nth i1 plst1)) "" "" goc (strcat (rtos (setq j (1+ j)) 2 0) m) )
)
)
(setq i1 (1+ i1))
)
)
)

(setq ss2 (ssget "x" (list (cons 0 "insert") (cons 2 "test"))))
(setq ss3 (ACET-SS-REMOVE ss1 ss2))


;;;;;(if (= (strcase ans) "Y")
(command "move" ss3 "" p1 (list (- (car p1) 300) (cadr p1) (caddr p1)))
(command "move" ss1 "" p1 (list (car p1) (+ (cadr p1) 300) (caddr p1)))
;;;;;;)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)

)

Dạ cám ơn bác nhiều,nhưng lisp này bị lỗi khi đánh theo phương Y vài số bị ngược bác ạ.Bác xem lại giùm e lần cuối.

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 29 June 2011 - 01:01 AM
Bổ sung lisp theo góp ý của bác Ketxu

  • 0

#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 28 June 2011 - 02:46 PM

Dạ cám ơn bác nhiều,nhưng lisp này bị lỗi khi đánh theo phương Y vài số bị ngược bác ạ.Bác xem lại giùm e lần cuối.

Hề hề hề,'
Mình chưa hiểu cái khái niệm bị ngược của bạn. hãy gửi bản vẽ bị ngược lên và nói rõ bạn muốn cái xuôi là cái gì nhé.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#19 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 June 2011 - 02:59 PM

Hề hề hề,'
Mình chưa hiểu cái khái niệm bị ngược của bạn. hãy gửi bản vẽ bị ngược lên và nói rõ bạn muốn cái xuôi là cái gì nhé.....

Nó đây bác ạ:
http://www.cadviet.c...drawing1_67.dwg
  • 0

#20 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 28 June 2011 - 03:52 PM

Nó đây bác ạ:
http://www.cadviet.c...drawing1_67.dwg

Có vẻ như bác mod ưu ái bạn, cho ra hẳn 1 topic riêng :)
Bạn thử dùng cái này xem sao.
- Lần đầu dùng : lisp hỏi tên Block, nếu có rồi, dùng block đó. Nếu chưa có, tạo mới 1 block thuộc tính theo chiều cao text của style hiện tại
- Lần sau : lấy block lần trước
- Theo bản vẽ yêu cầu : chỉ có tác dụng với Line.
- Nhập dãy bắt đầu (số + chữ, ví dụ 1g, lisp sẽ tách số đầu để tăng -> 2g,3g...10g)
- Đánh số quay góc chèn block theo yêu cầu.Bạn cứ chọn tất cả Line cần làm, lisp sẽ :
Làm từ các đối tượng nằm ngang trước : đánh từ dưới lên trên, Block đứng
Đối tượng đứng : đánh từ trái sang phải, block nằm ra
Đối tượng Chéo : đánh theo thứ tự chọn, block đứng giữa Line
- Code không gọn do coding vội :|

(defun c:1(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 )
(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0))
(if (or (not #blkname)(= #blkname "" )) (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list
(setq lstEname (acet-ss-to-list (ssget '((0 . "LINE")))) lstLen '())
(foreach en lstEname
(cond
((equal (cadr (dxf 10 en))(cadr (dxf 11 en)) 0.1)
(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
((equal (car (dxf 10 en))(car (dxf 11 en)) 0.1)
(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)
;Sap xep :
(setq lstEname
(append
(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (dxf 10 y1)) (cadr (dxf 10 y2)))))
(vl-sort lstDoc '(lambda (y1 y2) (< (car (dxf 10 y1)) (car (dxf 10 y2)))))
lstkhac
)
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j) after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if (vl-position ent lstDoc)(setq goc -90)(setq goc 0))
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
(progn
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos i 2 0) after))
(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
)
(command "insert" #blkname (mid ent) 1 1 goc (strcat (rtos (+ j (1+ (vl-position len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)
(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
)

  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC