Jump to content
InfoFile
Tác giả: quoccuongvkt
Bài viết gốc: 11968
Tên lệnh: ff
AutoCAD với Excel
có bác nào có list chuyển từ exell sang cad xin gởi cho mình với, mình làm thống kêt thép trên exell nhưng mà chuyển qua cad rất khó khăn

Filename: 11968_ff.lsp
Tác giả: Detailing
Bài viết gốc: 200622
Tên lệnh: cir lisp
Điều khiển AutoCAD bằng VC++ (ObjectARX)

Hôm nay, tự nhiên thắc mắc vì sao mình sử dụng ARX làm gì cho phức tạp nhỉ? Do nghe người ta đồn nó chạy nhanh lắm??? :P
OK, vậy làm 1 cái test thử xem nó chạy nhanh đến mức nào và có đáng để "gặm" tiếp ko.
Do chỉ biết có vài thứ nên biết bao nhiêu xài bấy nhiêu.
yêu cầu test...
>>
Hôm nay, tự nhiên thắc mắc vì sao mình sử dụng ARX làm gì cho phức tạp nhỉ? Do nghe người ta đồn nó chạy nhanh lắm??? :P
OK, vậy làm 1 cái test thử xem nó chạy nhanh đến mức nào và có đáng để "gặm" tiếp ko.
Do chỉ biết có vài thứ nên biết bao nhiêu xài bấy nhiêu.
yêu cầu test là tạo ra 10000 (mười ngàn) CIRCLE có bán kính R=5 tại điểm O(0,0,0)
Sau đây là kết quả test


Và đây là các "test thủ" lưu ý: trong code .NET có phần tính thời gian và tất cả các command trên đều dùng đoạn code đó để tính thời gian thực hiện.

code lisp:

<<

Filename: 200622_cir_lisp.lsp
Tác giả: TaiNguyen79
Bài viết gốc: 250759
Tên lệnh: lw all
XIN LISP

Mình đang cần 1 lisp autocad khi chỉnh linewieght.
Nội dung của lisp như sau: Mình muốn khi đánh lệnh của lisp chỉ vào 1 nét vẽ (ví dụ nét tường màu 130) thì mình chỉ cần chỉ vào 1 nét vẽ của màu 130 sau đó chỉnh cho nó linewieght là 1 giá trị nào đó cho toàn bộ màu 130
Như 1 số lisp mình tìm hiểu như...

>>

Mình đang cần 1 lisp autocad khi chỉnh linewieght.
Nội dung của lisp như sau: Mình muốn khi đánh lệnh của lisp chỉ vào 1 nét vẽ (ví dụ nét tường màu 130) thì mình chỉ cần chỉ vào 1 nét vẽ của màu 130 sau đó chỉnh cho nó linewieght là 1 giá trị nào đó cho toàn bộ màu 130
Như 1 số lisp mình tìm hiểu như kk,ha,chlw thì lisp đó yêu cầu phải nhập đúng tên layer .C ái mình cần ở đây chỉ là 1 cú click rồi đặt nét.
Bạn nào có lisp tương tự hoặc đúng như thế cho mình xin với
Xin chân thành cám ơn

Của bạn đây :
Chỉ cần chọn đối tượng mẫu là lw cả lớp đó sẽ giống như vậy

(defun c:lw_all (/ lw eg lay)
(if (= (getvar "lwunits") 0) (setvar "lwunits" 1))
(setq lw (cdr (assoc 370 (setq eg (entget (car (entsel "\nselect obj : ")))))) lay (cdr (assoc 8 eg)))
(cond ((null lw) (setq lw "bylayer")) ((= lw -2) (setq lw "Byblock")) ((= lw -3) (setq lw "default")) (T (setq lw (* 0.01 lw))))
(command ".change" (ssget "X" (list (cons 8 lay))) "" "P" "LW" lw ""))

<<

Filename: 250759_lw_all.lsp
Tác giả: TaiNguyen79
Bài viết gốc: 250760
Tên lệnh: lw all
XIN LISP
Còn nếu muốn change theo màu thì dùng như vầy :

(defun c:lw_all (/ lw eg cor)
(if (= (getvar "lwunits") 0) (setvar "lwunits" 1))
(setq lw (cdr (assoc 370 (setq eg (entget (car (entsel "\nselect obj : ")))))) cor (cdr (assoc 62 eg)))
(if (null cor) (setq cor 256))
(cond ((null lw) (setq lw "bylayer")) ((= lw -2) (setq lw "Byblock")) ((= lw -3) (setq lw "default")) (T (setq lw (* 0.01 lw))))
(command ".change" (ssget "X" (list (cons 62 cor))) "" "P" "LW" lw...
>>
Còn nếu muốn change theo màu thì dùng như vầy :

(defun c:lw_all (/ lw eg cor)
(if (= (getvar "lwunits") 0) (setvar "lwunits" 1))
(setq lw (cdr (assoc 370 (setq eg (entget (car (entsel "\nselect obj : ")))))) cor (cdr (assoc 62 eg)))
(if (null cor) (setq cor 256))
(cond ((null lw) (setq lw "bylayer")) ((= lw -2) (setq lw "Byblock")) ((= lw -3) (setq lw "default")) (T (setq lw (* 0.01 lw))))
(command ".change" (ssget "X" (list (cons 62 cor))) "" "P" "LW" lw ""))

<<

Filename: 250760_lw_all.lsp
Tác giả: TaiNguyen79
Bài viết gốc: 251323
Tên lệnh: laytd
Cần giúp đỡ chỉnh sửa lisp chạy tọa độ

Có ai giúp E ko ah!

Chắc có lẽ ai cũng ngại sửa code. Hãy dùng lsp này nếu thấy đc

;---------------------------------------
;lay toa do thuan chieu kim dong ho
(defun c:laytd (/ p bound k lstpt lstx lsty newlst i bien t1 p1 diem x y ymax kmax n c new name ltext diemve pt p1
p2 p3 p4 p5 p6 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13...
>>

Có ai giúp E ko ah!

Chắc có lẽ ai cũng ngại sửa code. Hãy dùng lsp này nếu thấy đc

;---------------------------------------
;lay toa do thuan chieu kim dong ho
(defun c:laytd (/ p bound k lstpt lstx lsty newlst i bien t1 p1 diem x y ymax kmax n c new name ltext diemve pt p1
p2 p3 p4 p5 p6 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16 pt17)
(setq osm (getvar "osmode") lay (getvar "clayer") orth (getvar "orthomode"))
(initget 1)(setq p (getpoint "\nPick point :"))
(setvar "osmode" 0) (setq EL (entlast))
(taolop '("vunglaytd" "diemtd" "texttd"))
(setvar "clayer" "vunglaytd")
(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")
(if (/= p nil) (command "-Boundary" p "" ));end if
(setq bound (entlast))
(if (equal bound EL) (exit))
(setq bound (entget bound))
(setq k (cdr (assoc 90 bound)))
(setq lstpt '() lstx '() lsty '() newlst '())
(setq i 1)
(while (<= i k)
(progn
(setq bien (assoc 10 bound))
(setq t1 (member bien bound))
(setq p1 (car t1))
(setq bound (cdr t1))
(setq diem (cdr p1))
(setq x (car diem) y (cadr diem))
(setq lstx (append lstx (list x)) lsty (append lsty (list y)))
(setq lstpt (append lstpt (list diem)))
(setq i (+ 1 i))));while
(setq ymax (maximum lsty))
(setq kmax (vl-position ymax (reverse lsty)))
(setq lstpt (reverse lstpt))
(setq newlst (member (nth kmax lstpt) lstpt))
(setq n 0)
(repeat kmax (setq newlst (append newlst (list (nth n lstpt)))) (setq n (+ 1 n)))
(setq c 0 new '())
(foreach name newlst (setq new (append new (list (append (list (setq c (1+ c))) name)))))
(setq c 1 new (append new (list (nth 0 new))))
(setq ltext '())
(setq ltext (append ltext (list (nth 0 new))))
(setq newlst (append newlst (list (nth 0 newlst))))
(repeat (- (length new) 1)
(setq ltext (append ltext (list (append (nth c new)
(list (distance (append (nth (- c 1) newlst) '(0.0)) (append (nth c newlst) '(0.0))))))))
(setq c (1+ c)));repeat
(setq n 0)
(setvar "clayer" "diemtd")
(repeat (- (length new) 1)
(ndait_addtext (itoa (car (nth n new))) "texttd" 256 (cdr (nth n new)) 1.0 0.0 "aptima" "BL")
(command "CIRCLE" (cdr (nth n new)) "0.25" "")
(setq n (1+ n)));repeat
(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))
(if (null diemve)
(prompt "\nKhong ve bang ! ")
(progn
(setvar "osmode" 0)
(setvar "orthomode" 0)
(taolop '("Text_Bang" "Line_Bang"))
(setq pt diemve)
(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")
(command "layer" "s" "Line_Bang" "")
(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))
(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))
(setq p1 p
p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)
p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)
P4 (polar p3 0.0 7.0)
p5 (polar p4 0.0 9.0)
p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5))
(setq pt2 (polar pt1 0.0 5.5)
pt3 (polar pt2 0.0 18.0)
pt4 (polar pt3 0.0 5.5)
pt5 (polar pt2 (* 1.5 Pi) 2.5)
pt6 (polar pt5 0.0 9.0)
pt7 (polar pt6 0.0 9.0)
pt8 (polar pt1 (* 1.5 Pi) 5.0)
pt9 (polar pt8 0.0 5.5)
pt10 (polar pt9 0.0 9.0)
pt11 (polar pt10 0.0 9.0)
pt12 (polar pt11 0.0 5.5))
(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")
(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")
(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")
(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")
(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")
(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")
(command "layer" "s" "Line_Bang" "")
(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "")
(command "line" pt2 pt3 "")
(command "line" pt5 pt9 "")
(command "line" pt6 pt10 "")
(command "line" pt7 pt11 "")
(setq pt (polar pt (* 1.5 pi) 6.9))
(setq i 0)
(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))
(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25)))
(setq pt14 (polar pt13 0.0 5.5)
pt15 (polar pt14 0.0 9.0)
pt16 (polar pt15 0.0 9.0)
pt17 (polar pt16 0.0 5.5))
(command "layer" "s" "Line_Bang" "")
(command "line" pt8 pt13 pt14 pt9 "")
(command "line" pt14 pt15 pt10 "")
(command "line" pt15 pt16 pt11 "")
(command "line" pt16 pt17 pt12 "")
));if
(setvar "osmode" osm) (setvar "clayer" lay) (setvar "orthomode" orth)
(princ))
;;Tao lop theo danh sach di kem
(defun taolop (dslop) (mapcar '(lambda (a) (if (null (tblsearch "layer" a)) (command "layer" "N" a ""))) dslop))
;Tra ve so lon nhat trong danh sach a
(defun maximum (a)
(setq i 0 maxa (max (nth 0 a) (nth 1 a)))
(repeat (length a) (setq maxa (max (nth i a) maxa)) (setq i (1+ i))) maxa)
;Ham tao text
;noi dung va kieu "not nil"
;cac doi so khac co the dung nil
(defun Ndait_addtext (noidung lop mau diem caochu goc kieu canhchu / x y va ha)
(cond
((= canhchu "L") (setq va 0 ha 0));Left
((= canhchu "C") (setq va 0 ha 1));Center
((= canhchu "R") (setq va 0 ha 2));Right
;((= canhchu "A") (setq va 0 ha 3));Aligned
((= canhchu "M") (setq va 0 ha 4));Middle
;((= canhchu "F") (setq va 0 ha 5));Fit
((= canhchu "TL") (setq va 3 ha 0));Top Left
((= canhchu "TC") (setq va 3 ha 1));Top Center
((= canhchu "TR") (setq va 3 ha 2));Top Right
((= canhchu "ML") (setq va 2 ha 0));Middle Left
((= canhchu "MC") (setq va 2 ha 1));Middle Center
((= canhchu "MR") (setq va 2 ha 2));Middle Right
((= canhchu "BL") (setq va 1 ha 0));Bottom Left
((= canhchu "BC") (setq va 1 ha 1));Bottom Center
((= canhchu "BR") (setq va 1 ha 2));Bottom Right
(T (setq va 0 ha 0));canhchu false -> Left
);cond
(if (null (tblsearch "style" kieu)) (setq kieu (getvar "textstyle")))
(if (null goc) (setq goc 0.0))
(if (null caochu) (setq caochu 1.0))
(if (null diem) (progn (initget 1) (setq diem (getpoint "\npick point :"))))
(if (null mau) (setq mau 256))
(if (null lop) (setq lop (getvar "clayer")))
(setq x (car diem) y (cadr diem))
(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop)
(cons 62 mau) (cons 100 "AcDbText") (list 10 x y 0.0)
(cons 40 caochu) (cons 50 goc)(cons 1 noidung) (cons 7 kieu)
(cons 72 ha) (list 11 x y 0.0) (cons 100 "AcDbText") (cons 73 va))))
);defun
;-----
(defun taochu (noidung lop mau diem caochu kieu / x y)
(setq x (car diem) y (cadr diem))
(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop) (cons 62 mau)
(cons 100 "AcDbText") (list 10 x y 0.0) (cons 40 caochu)
(cons 1 noidung) (cons 7 kieu))))) ;defun
;;;------------------------------------
(defun ghihang (pt hang / p p1 p2 p3 pt pt2 pt3 pt4 pt5 t1 t2 t3 t4)
(setq t1 (rtos (car hang) 2 0) t2 (trtos (cadr hang) 3) t3 (trtos (cadr (cdr hang)) 3))
(if (not (null (nth 3 hang))) (setq t4 (trtos (nth 3 hang) 2)))
(setq p1 (polar (polar pt 0.0 2.0) (/ pi 2.0) 0.25) p2 (polar p1 0.0 12.0)
p3 (polar p2 0.0 8.5) p4 (polar (polar p3 0.0 5.5) (* 0.5 Pi) 1.0))
(Ndait_addtext t1 "Text_Bang" 256 p1 0.9 nil "aptima" "C")
(Ndait_addtext t3 "Text_Bang" 256 p2 0.9 nil "aptima" "R")
(Ndait_addText t2 "Text_Bang" 256 p3 0.9 nil "aptima" "R")
(if (not (null t4)) (Ndait_addText t4 "Text_Bang" 256 p4 0.9 nil "aptima" "R")));end of defun
;;Doi so thuc sang chuoi (giong rtos)
;;VD (trtos 1.05 3) -> "1.050"
(defun trtos (Num dec / HSLT N0 N1 N2 N3 them0 them1 CHU)
(setq HSLT dec N0 (+ Num 0.000000001) N1 (- N0 (fix N0)) N2 (rtos N1 2 HSLT)
N3 (- (strlen N2) 2) them0 "." them1 "")
(if (>= N3 HSLT)
(setq CHU (rtos N0 2 HSLT))
(if (= N3 -1)
(setq CHU (strcat (rtos N0 2 HSLT)(if (= HSLT 0) (setq them0 "") (repeat HSLT (setq them0 (strcat them0 "0"))))))
(setq CHU (strcat (rtos N0 2 HSLT)(repeat (- HSLT N3) (setq them1 (strcat them1 "0"))))))) CHU)

<<

Filename: 251323_laytd.lsp
Tác giả: hochoaivandot
Bài viết gốc: 251590
Tên lệnh: ttt
Lisp vẽ pline qua các text theo giá trị tăng dần

(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 dxf (code e) (cdr (assoc code (entget e))))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62...

>>

(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 dxf (code e) (cdr (assoc code (entget e))))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint (setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end
(defun C:ttt(/ ss lst lstPt)
(setq ss (ssget (list (cons 0 "TEXT"))))
(setq lst (LM:ss->ent ss))
(setq lst (vl-sort lst
(function (lambda (e1 e2)
(< (atof (dxf 1 e1)) (atof (dxf 1 e2)))))))
(setq lstPt (mapcar '(lambda (x) (dxf 10 x)) lst))
(MakeLWPolyline lstPt nil nil nil nil nil nil)
)

Phải thế không bạn?

Các text bạn chọn phải là số nhé. Và thứ tự đỉnh Pline là thứ tự lớn bé của các số...


<<

Filename: 251590_ttt.lsp
Tác giả: KangKung
Bài viết gốc: 251996
Tên lệnh: test
Lisp xoay bản vẽ trong khung chữ nhật Layout

Bạn thử Lisp này xem:

(defun C:test( / n vp)
  (vl-load-com)
  (if (= (getvar "Tilemode") 0)
    (progn
      (if (/= (getvar "cvport") 1) (command "PSPACE"))
      (setq vp(car(entsel "\n Select viewport:")))
      (setq n(cdr(assoc 69 (entget vp))))
      (command "MSPACE")
      (setvar "cvport" n)
      (vla-put-twistangle (vlax-ename->vla-object vp) (/ pi 4))
      (command "Zoom" "E")
      )
    (alert "\n Chuyen sang Layout truoc khi...
>>

Bạn thử Lisp này xem:

(defun C:test( / n vp)
  (vl-load-com)
  (if (= (getvar "Tilemode") 0)
    (progn
      (if (/= (getvar "cvport") 1) (command "PSPACE"))
      (setq vp(car(entsel "\n Select viewport:")))
      (setq n(cdr(assoc 69 (entget vp))))
      (command "MSPACE")
      (setvar "cvport" n)
      (vla-put-twistangle (vlax-ename->vla-object vp) (/ pi 4))
      (command "Zoom" "E")
      )
    (alert "\n Chuyen sang Layout truoc khi chay Lisp!")
    )
  (princ)
  )

 


<<

Filename: 251996_test.lsp
Tác giả: HoaVien
Bài viết gốc: 252012
Tên lệnh: rv
Lisp xoay bản vẽ trong khung chữ nhật Layout

Sài thử Lisp này xem :

 

(defun c:rv( / n vp)
  (vl-load-com)
  (if (= (getvar "Tilemode") 0)
    (progn
      (if (/= (getvar "cvport") 1)
	(vla-Put-MSpace (vla-Get-ActiveDocument (vlax-Get-Acad-Object)) :vlax-False))
      (prompt "\nChont viewport can xuay: ")
      (if (and (setq ss (ssget ":S+." '((0 . "VIEWPORT"))))
	       (setq ang (getangle "\nNhap goc xuay: ")))
	(vla-Put-TwistAngle (vlax-EName->vla-Object (ssname ss 0)) ang) )...
>>

Sài thử Lisp này xem :

 

(defun c:rv( / n vp)
  (vl-load-com)
  (if (= (getvar "Tilemode") 0)
    (progn
      (if (/= (getvar "cvport") 1)
	(vla-Put-MSpace (vla-Get-ActiveDocument (vlax-Get-Acad-Object)) :vlax-False))
      (prompt "\nChont viewport can xuay: ")
      (if (and (setq ss (ssget ":S+." '((0 . "VIEWPORT"))))
	       (setq ang (getangle "\nNhap goc xuay: ")))
	(vla-Put-TwistAngle (vlax-EName->vla-Object (ssname ss 0)) ang) ) )      
    (alert "\n Chuyen sang Layout truoc khi chay Lisp!")    )
  (princ)  )

<<

Filename: 252012_rv.lsp
Tác giả: toiyeuvietnam
Bài viết gốc: 246026
Tên lệnh: ldd duong
Lisp tạo các Layer cho trước trong một bản vẽ mới

cảm ơn anh Ket, gõ lệnh đó như vậy đúng là ổn rồi. em gộp cái CELTSCALE vào trong cái DUONG thì nó báo lỗi ; error: no function definition: C:CELTSCALE (không có định nghĩa chức năng: C: CELTSCALE). em gộp như vậy sai chỗ nào ảnh nhỉ?

 

 (defun C:LDD()
(c:CELTSCALE...
>>

cảm ơn anh Ket, gõ lệnh đó như vậy đúng là ổn rồi. em gộp cái CELTSCALE vào trong cái DUONG thì nó báo lỗi ; error: no function definition: C:CELTSCALE (không có định nghĩa chức năng: C: CELTSCALE). em gộp như vậy sai chỗ nào ảnh nhỉ?

 

 (defun C:LDD()
(c:CELTSCALE )
(c:DUONG)
)
(defun c:DUONG (/ *error* old_lay) 
(defun *error* (msg)
   (setvar "clayer" old_lay) (princ))
  (setq old_lay (getvar "clayer"))
  (command "_.layer"  "_m" "DUONG DI" "_c" "1" "" "L" "Hidden" "" "LW" "0.3" "" "") 

(setvar "osmode" (+ 1 2 8 32 128))

(command "_.LINE") (princ))





 

 

 

 


<<

Filename: 246026_ldd_duong.lsp
Tác giả: Skywings
Bài viết gốc: 252462
Tên lệnh: t1
Biện pháp tăng tốc độ trong các chương trình Lisp

Bác hiểu sai ý bác TueNV rồi !

Mình nói thế này để bác dễ hiểu nhé,

giã sữ gốc 0,0,0 của hệ toạ độ trùng với điểm đang xét, bạn loại trừ trục Z ra thì vô tình điểm có toạ độ (0,0,+"vô cùng") lại có khoảng cách đến điểm đang xét ngắn hơn điểm có toạ độ (1,1,0)...

>>

Bác hiểu sai ý bác TueNV rồi !

Mình nói thế này để bác dễ hiểu nhé,

giã sữ gốc 0,0,0 của hệ toạ độ trùng với điểm đang xét, bạn loại trừ trục Z ra thì vô tình điểm có toạ độ (0,0,+"vô cùng") lại có khoảng cách đến điểm đang xét ngắn hơn điểm có toạ độ (1,1,0) ...

 

Mình có nói bỏ luôn Z đâu, chỉ quy về mp XY trong việc chia vùng chọn.

 

 

Bạn thử chưa? Bạn kiểm tra đối tượng mà bạn chọn đó có đồng phẳng không?

(ssget) với tham số "c" "cp" "wp" chỉ có thể chọn đối tượng đồng phẳng thôi, còn 3D thì không được .........

 

Mình đã test rùi, tham số "W" và "C" chắc chắn được, "WP" và "CP" chắc chắn ... ko được ^^. Đoạn code đơn giản để test, bác có thể thử phun vài điểm point lên màn hình và thay đổi Z cho chúng.

 

(defun c:t1 (/ N P1 P2 PNT PNTLST)
  (setq	p1 (3dPnt->2dPnt (getpoint "1st point"))
	p2 (3dPnt->2dPnt (getpoint "2nd point"))
  )
  (setq
;;;    pntLst (ssget "_W" p1 p2)
    pntLst
     (ssget "_C" p1 p2)
  )
  (setq n 0)
  (if pntLst
    (repeat (sslength pntLst)
      (setq pnt (cdr (assoc 10 (entget (ssname pntLst n)))))
      (print pnt)
      (setq n (1+ n))
    )
  )
  (princ)
)
(defun 3dPnt->2dPnt (3dpt)
  (list (float (car 3dpt)) (float (cadr 3dpt)))
)

<<

Filename: 252462_t1.lsp
Tác giả: gia_bach
Bài viết gốc: 252484
Tên lệnh: addpoint
Biện pháp tăng tốc độ trong các chương trình Lisp

Gửi anh em hàm "phun" ngẫu nhiên 1 số Point để test.

;;generate random points
(defun c:addPoint()
  ;;from internet
  (defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 0.3171943	     )  ))
  (defun random-n (n) (* n (random)))
  ;main
  (repeat 100000 ;2D Point
    (entmake (list (cons 0 "POINT") (cons 10 (list (random-n 100000) (random-n 60000) 0))  )  ) )
  (repeat 5000 ;3D Point
    (entmake (list (cons...
>>

Gửi anh em hàm "phun" ngẫu nhiên 1 số Point để test.

;;generate random points
(defun c:addPoint()
  ;;from internet
  (defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 0.3171943	     )  ))
  (defun random-n (n) (* n (random)))
  ;main
  (repeat 100000 ;2D Point
    (entmake (list (cons 0 "POINT") (cons 10 (list (random-n 100000) (random-n 60000) 0))  )  ) )
  (repeat 5000 ;3D Point
    (entmake (list (cons 0 "POINT") (cons 10 (list (random-n 100000) (random-n 60000) (random-n 300)))  )  ) ))

Và đây là 1 cách mà Hà cho là lâu nhất (duyệt qua toàn bộ selection).

(defun c:test (/ ss pt i e st lst)
  ;By Gia_Bach
  (setq pt (getpoint "pick point")
	ss  (ssget "_x" '((0 . "point")))	
	i  -1
	st (getvar 'millisecs))
  (while (setq e (ssname ss (setq i (1+ i)))) (setq lst (cons (cdr (assoc 10 (entget e))) lst)))
  (setq lst (vl-sort lst (function (lambda (a b) (<= (distance a pt) (distance b pt))))) )
  (entmakex (list '(0 . "LINE") (cons 10 pt) (cons 11 (car lst))))  
  (princ (strcat "\nProgram running time: " (rtos (/ (- (getvar 'millisecs) st) 1000.) 2 4) " msecs."))
 (princ))

<<

Filename: 252484_addpoint.lsp
Tác giả: gia_bach
Bài viết gốc: 252484
Tên lệnh: test
Biện pháp tăng tốc độ trong các chương trình Lisp

Gửi anh em hàm "phun" ngẫu nhiên 1 số Point để test.

;;generate random points
(defun c:addPoint()
  ;;from internet
  (defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 0.3171943	     )  ))
  (defun random-n (n) (* n (random)))
  ;main
  (repeat 100000 ;2D Point
    (entmake (list (cons 0 "POINT") (cons 10 (list (random-n 100000) (random-n 60000) 0))  )  ) )
  (repeat 5000 ;3D Point
    (entmake (list (cons...
>>

Gửi anh em hàm "phun" ngẫu nhiên 1 số Point để test.

;;generate random points
(defun c:addPoint()
  ;;from internet
  (defun random ()
    (setq seed (if seed
		 (rem (+ (* seed 15625.7) 0.21137152) 1)
		 0.3171943	     )  ))
  (defun random-n (n) (* n (random)))
  ;main
  (repeat 100000 ;2D Point
    (entmake (list (cons 0 "POINT") (cons 10 (list (random-n 100000) (random-n 60000) 0))  )  ) )
  (repeat 5000 ;3D Point
    (entmake (list (cons 0 "POINT") (cons 10 (list (random-n 100000) (random-n 60000) (random-n 300)))  )  ) ))

Và đây là 1 cách mà Hà cho là lâu nhất (duyệt qua toàn bộ selection).

(defun c:test (/ ss pt i e st lst)
  ;By Gia_Bach
  (setq pt (getpoint "pick point")
	ss  (ssget "_x" '((0 . "point")))	
	i  -1
	st (getvar 'millisecs))
  (while (setq e (ssname ss (setq i (1+ i)))) (setq lst (cons (cdr (assoc 10 (entget e))) lst)))
  (setq lst (vl-sort lst (function (lambda (a b) (<= (distance a pt) (distance b pt))))) )
  (entmakex (list '(0 . "LINE") (cons 10 pt) (cons 11 (car lst))))  
  (princ (strcat "\nProgram running time: " (rtos (/ (- (getvar 'millisecs) st) 1000.) 2 4) " msecs."))
 (princ))

<<

Filename: 252484_test.lsp
Tác giả: hiepttr
Bài viết gốc: 252562
Tên lệnh: ddd
đo đường polyline

Viết bậy cho qua ngày

Bạn dùng đc thì dùng, ko dc thì cũng đừng ném đá :D :D :D

;dim nhanh
(defun c:DDD( / sel pl pre group)
(setq sel (car (entsel "\nChon polyline: ")))
(command ".copy" sel "" (list 0 0 0) "@0,0,0")
(setq pl (entlast))
(command ".explode" pl)
(setq pre pl
	group (ssadd)
	)
(while (setq pre (entnext pre))
		(setq group (ssadd pre group))
)
(setq i 0)
(while (< i (sslength group))
(progn
(setq ename (ssname group...
>>

Viết bậy cho qua ngày

Bạn dùng đc thì dùng, ko dc thì cũng đừng ném đá :D :D :D

;dim nhanh
(defun c:DDD( / sel pl pre group)
(setq sel (car (entsel "\nChon polyline: ")))
(command ".copy" sel "" (list 0 0 0) "@0,0,0")
(setq pl (entlast))
(command ".explode" pl)
(setq pre pl
	group (ssadd)
	)
(while (setq pre (entnext pre))
		(setq group (ssadd pre group))
)
(setq i 0)
(while (< i (sslength group))
(progn
(setq ename (ssname group i)
	info (entget ename)
	)
(command ".DIMALIGNED" (cdr (assoc 10 info)) (cdr (assoc 11 info)) (polar (cdr (assoc 10 info)) (+ (angle (cdr (assoc 10 info)) (cdr (assoc 11 info))) (/ pi 2)) 10))
(setq i (1+ i))
))
(command ".erase" group "")
(princ)
)

<<

Filename: 252562_ddd.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 252656
Tên lệnh: xotxt
Mã dfx của text

Tôi đang viết lisp xử lý text có 1 vướng mắc chưa hiểu mong mọi người giúp đỡ

Lisp thứ 1 

Tính tổng các text chọn trên màn hình thay vào 1 text đã có trên màn hình text kết quả tự đổi màu (nhằm kiểm soát việc tính toán)

vướng mắc là nếu text chọn để thay kết quả vơi màu của text không phải màu layer thì kết quả đúng ý muốn, còn ngược lại màu text là màu layer thì...

>>

Tôi đang viết lisp xử lý text có 1 vướng mắc chưa hiểu mong mọi người giúp đỡ

Lisp thứ 1 

Tính tổng các text chọn trên màn hình thay vào 1 text đã có trên màn hình text kết quả tự đổi màu (nhằm kiểm soát việc tính toán)

vướng mắc là nếu text chọn để thay kết quả vơi màu của text không phải màu layer thì kết quả đúng ý muốn, còn ngược lại màu text là màu layer thì kết quả vẫn đúng nhưng text không đổi màu. qua tìm hiểu tối thấy 

text có màu không phải màu layer có thêm mã dfx 62

text có màu là màu layer không có mã dfx 62

đây là lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun c:ccc ()
(CONG))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun cong ()
(princ "\nNguyen Huu Nhan - Quang Binh")
(setq oldos (getvar "OSMODE")) 
 (setq SUMb 0)
 (Princ "\nHay chon cac so can cong :")
 (setq SS (ssget '((0 . "TEXT"))))
 (setq i 0)
 (setq N (sslength ss))
 (while (< i N)
   (setq DT (ssname SS i))
   (setq DT (entget DT))
   (setq TEXT (cdr (assoc 1 DT)))
   (setq SUM1 (atof TEXT)) 
   (setq SUMb (+ SUMb (* SUM1 1)))
   (setq i (1+ i))
 )
  ;(luuos)
  (setvar "osmode" 0)
(setq giatriold (entsel "\nGia tri can thay the"))
	(while
 	 (or
   	 (null giatriold)
   	 (/= "TEXT" (cdr (assoc 0 (entget (car giatriold)))))
	 )
	(princ "\nDoi tuong khong phai la text! Chon lai")
 	(setq giatriold (entsel "\nGia tri can thay the"))
	)
(setq thongtin (entget (car giatriold)))
(setq giatricu (assoc 1 thongtin))
(setq giatrimoi (cons 1 (rtos SUMb 2 2)))
(setq thongtin (subst giatrimoi giatricu thongtin))
(setq thongtin (subst (cons 62 3) (assoc 62 thongtin) thongtin))
(entmod thongtin)
(setvar "MODEMACRO" "**Phong Tu Van Giao Thong II** huunhanltqb@yahoo.com")
(setvar "osmode" oldos)
(Princ)
) 

Nhờ mọi người ai biết sửa giúp. rất cám ơn

Lisp thứ 2

Lisp thay đổi điểm đặt của text  (thay đổi mã dfx 11) lisp này cũng vướng mắc là nếu các mã dfx 71,72,73 khác 0 thì text thay đổi vị trí còn ngược lại thì không. mọi người có thể cho tôi biết khi nào là mã dfx 71,72,73 khác 0 và ai biết có thể sửa lisp này cho tôi.

Mục đích lisp này là Cho 1 đường Pl (tim tuyến) và 1 tập text (tên cọc)  sau khi chọn tên cọc chọn pl định hướng các text này sẽ xoay theo hướng PL đồng thời di chuyển đến gần đường PL 1 khoảng cách nhập vào

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69045-nho-chinh-sua-lisp-xoay-text-theo-pline/page-2
(defun c:xotxt ();(/ oldos sst pl obj p0 par pa1 pa2 pa3 etxt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(alert "Chon tap hop text can xoay")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq pl (car (entsel "\n Chon polyline dinh huong")))
(setq k (getreal "\n Nhap khoang cach move: ")) 
(setq obj (vlax-ename->vla-object pl))
(foreach txt sst
(setq p0 (if (or (/= (cdr (assoc 72 (setq etxt (entget txt)))) 0) (/= (cdr (assoc 73 etxt)) 0)) 
(vlax-curve-getclosestpointto obj (cdr (assoc 11 etxt)) T)                   
(vlax-curve-getclosestpointto obj (cdr (assoc 10 etxt)) T))       
par (vlax-curve-getparamatpoint obj p0)        
pa1 (vlax-curve-getpointatparam obj (fix par))        
pa2 (vlax-curve-getpointatparam obj  par))
(if (not (equal pa1 pa2 0.000001))        
(setq goc (angle pa1 pa2))        
(if (setq pa3 (vlax-curve-getpointatparam obj (1+ par)))            
(setq goc (angle pa1 pa3))            
(setq goc (+ pi (angle pa1 (vlax-curve-getpointatparam obj (1- par)))))))
(setq etxt (subst (cons 50 goc) (assoc 50 etxt) etxt))
(setq kt (cdr (assoc 72 etxt)))
(setq p (if (or (/= (cdr (assoc 72 etxt)) 0) (/= (cdr (assoc 73 etxt)) 0))
                        (cdr (assoc 11 etxt)) (cdr (assoc 10 etxt))))
(setq gocch (+ goc (/ pi 2)))
(setq pc (polar p gocch k))
(setq etxt (subst (cons 11 pc) (assoc 11 etxt) etxt))
(entmod etxt))
(command "undo" "e")
(setvar "osmode" oldos)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     

 


<<

Filename: 252656_xotxt.lsp
Tác giả: huunhantvxdts
Bài viết gốc: 252656
Tên lệnh: ccc
Mã dfx của text

Tôi đang viết lisp xử lý text có 1 vướng mắc chưa hiểu mong mọi người giúp đỡ

Lisp thứ 1 

Tính tổng các text chọn trên màn hình thay vào 1 text đã có trên màn hình text kết quả tự đổi màu (nhằm kiểm soát việc tính toán)

vướng mắc là nếu text chọn để thay kết quả vơi màu của text không phải màu layer thì kết quả đúng ý muốn, còn ngược lại màu text là màu layer thì...

>>

Tôi đang viết lisp xử lý text có 1 vướng mắc chưa hiểu mong mọi người giúp đỡ

Lisp thứ 1 

Tính tổng các text chọn trên màn hình thay vào 1 text đã có trên màn hình text kết quả tự đổi màu (nhằm kiểm soát việc tính toán)

vướng mắc là nếu text chọn để thay kết quả vơi màu của text không phải màu layer thì kết quả đúng ý muốn, còn ngược lại màu text là màu layer thì kết quả vẫn đúng nhưng text không đổi màu. qua tìm hiểu tối thấy 

text có màu không phải màu layer có thêm mã dfx 62

text có màu là màu layer không có mã dfx 62

đây là lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun c:ccc ()
(CONG))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun cong ()
(princ "\nNguyen Huu Nhan - Quang Binh")
(setq oldos (getvar "OSMODE")) 
 (setq SUMb 0)
 (Princ "\nHay chon cac so can cong :")
 (setq SS (ssget '((0 . "TEXT"))))
 (setq i 0)
 (setq N (sslength ss))
 (while (< i N)
   (setq DT (ssname SS i))
   (setq DT (entget DT))
   (setq TEXT (cdr (assoc 1 DT)))
   (setq SUM1 (atof TEXT)) 
   (setq SUMb (+ SUMb (* SUM1 1)))
   (setq i (1+ i))
 )
  ;(luuos)
  (setvar "osmode" 0)
(setq giatriold (entsel "\nGia tri can thay the"))
	(while
 	 (or
   	 (null giatriold)
   	 (/= "TEXT" (cdr (assoc 0 (entget (car giatriold)))))
	 )
	(princ "\nDoi tuong khong phai la text! Chon lai")
 	(setq giatriold (entsel "\nGia tri can thay the"))
	)
(setq thongtin (entget (car giatriold)))
(setq giatricu (assoc 1 thongtin))
(setq giatrimoi (cons 1 (rtos SUMb 2 2)))
(setq thongtin (subst giatrimoi giatricu thongtin))
(setq thongtin (subst (cons 62 3) (assoc 62 thongtin) thongtin))
(entmod thongtin)
(setvar "MODEMACRO" "**Phong Tu Van Giao Thong II** huunhanltqb@yahoo.com")
(setvar "osmode" oldos)
(Princ)
) 

Nhờ mọi người ai biết sửa giúp. rất cám ơn

Lisp thứ 2

Lisp thay đổi điểm đặt của text  (thay đổi mã dfx 11) lisp này cũng vướng mắc là nếu các mã dfx 71,72,73 khác 0 thì text thay đổi vị trí còn ngược lại thì không. mọi người có thể cho tôi biết khi nào là mã dfx 71,72,73 khác 0 và ai biết có thể sửa lisp này cho tôi.

Mục đích lisp này là Cho 1 đường Pl (tim tuyến) và 1 tập text (tên cọc)  sau khi chọn tên cọc chọn pl định hướng các text này sẽ xoay theo hướng PL đồng thời di chuyển đến gần đường PL 1 khoảng cách nhập vào

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/69045-nho-chinh-sua-lisp-xoay-text-theo-pline/page-2
(defun c:xotxt ();(/ oldos sst pl obj p0 par pa1 pa2 pa3 etxt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(alert "Chon tap hop text can xoay")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq pl (car (entsel "\n Chon polyline dinh huong")))
(setq k (getreal "\n Nhap khoang cach move: ")) 
(setq obj (vlax-ename->vla-object pl))
(foreach txt sst
(setq p0 (if (or (/= (cdr (assoc 72 (setq etxt (entget txt)))) 0) (/= (cdr (assoc 73 etxt)) 0)) 
(vlax-curve-getclosestpointto obj (cdr (assoc 11 etxt)) T)                   
(vlax-curve-getclosestpointto obj (cdr (assoc 10 etxt)) T))       
par (vlax-curve-getparamatpoint obj p0)        
pa1 (vlax-curve-getpointatparam obj (fix par))        
pa2 (vlax-curve-getpointatparam obj  par))
(if (not (equal pa1 pa2 0.000001))        
(setq goc (angle pa1 pa2))        
(if (setq pa3 (vlax-curve-getpointatparam obj (1+ par)))            
(setq goc (angle pa1 pa3))            
(setq goc (+ pi (angle pa1 (vlax-curve-getpointatparam obj (1- par)))))))
(setq etxt (subst (cons 50 goc) (assoc 50 etxt) etxt))
(setq kt (cdr (assoc 72 etxt)))
(setq p (if (or (/= (cdr (assoc 72 etxt)) 0) (/= (cdr (assoc 73 etxt)) 0))
                        (cdr (assoc 11 etxt)) (cdr (assoc 10 etxt))))
(setq gocch (+ goc (/ pi 2)))
(setq pc (polar p gocch k))
(setq etxt (subst (cons 11 pc) (assoc 11 etxt) etxt))
(entmod etxt))
(command "undo" "e")
(setvar "osmode" oldos)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     

 


<<

Filename: 252656_ccc.lsp
Tác giả: Tue_NV
Bài viết gốc: 253149
Tên lệnh: fz
Giúp dùm em lệnh Tolerance!

Sau 2 năm xài lisp của bác em thấy rất OK, nhưng bây giờ phát sinh là em tìm ví dụ: P1-1 thì nó báo là hơn 50 đối tượng bao gồm cả P1-11, P1-12, P1-111..... có nghĩa là cái nào có chữ màu đỏ là nó tìm...

>>

Sau 2 năm xài lisp của bác em thấy rất OK, nhưng bây giờ phát sinh là em tìm ví dụ: P1-1 thì nó báo là hơn 50 đối tượng bao gồm cả P1-11, P1-12, P1-111..... có nghĩa là cái nào có chữ màu đỏ là nó tìm tuốt, trong khi đó em chỉ mún tìm chính xác P1-1 thôi ah! giờ sửa dùm em được ko ah, nghĩa là nếu mình gõ như thế nào thì nó tìm y chang như vậy (gõ P1-1 thì tìm đúng P1-1) còn mún tìm nhìu thì gõ P1-1* (dấu * đại diện cho các ký tự đại diện)

Thanks bác nhìu!

 

Anh sửa lại Lisp của Ketxu 1 tí cho em. Em chạy thử nhé:

(defun c:fz( / t2f sss lst ent minpoint maxpoint oEcho)
(vl-load-com)
(setq oEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)
  (setq
    t2f (getstring t "\nChuoi can tim (ket thuc bang enter):")
    sss (ssget "X" (list (cons 0 "TOLERANCE")
                                     (cons 1 (strcat "*" (if (= (substr t2f 1 1) "*") "*" "%%v")  t2f
                                                                 (if (= (substr t2f (strlen t2f) 1) "*") "*" "%%v") "*" ))))       
    lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss)))
  )
 
(alert (strcat "\nTim thay " (itoa (length lst)) " doi tuong!")) 
(foreach ent lst
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
 (setq minpoint (vlax-safearray->list minpoint)
               maxpoint (vlax-safearray->list maxpoint))
    (command ".zoom" minpoint maxpoint)
    (command ".zoom" "0.5xp")   
    (getstring "\nNhan enter hoac spacebar de tiep tuc!")
  )
(setvar "cmdecho" oEcho)
  (princ)
)
(defun c:fz( / t2f sss lst ent minpoint maxpoint oEcho)
(vl-load-com)
(setq oEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)
  (setq
    t2f (getstring t "\nChuoi can tim (ket thuc bang enter):")
    sss (ssget "X" (list (cons 0 "TOLERANCE") 
(cons 1 (strcat "*" (if (= (substr t2f 1 1) "*") "*" "%%v")  t2f 
    (if (= (substr t2f (strlen t2f) 1) "*") "*" "%%v") "*" ))))        
    lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss)))
  )
 
(alert (strcat "\nTim thay " (itoa (length lst)) " doi tuong!"))  
(foreach ent lst
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
 (setq minpoint (vlax-safearray->list minpoint) 
  maxpoint (vlax-safearray->list maxpoint))
    (command ".zoom" minpoint maxpoint)
    (command ".zoom" "0.5xp")    
    (getstring "\nNhan enter hoac spacebar de tiep tuc!")
  )
(setvar "cmdecho" oEcho)
  (princ)
)
(defun c:fz( / t2f sss lst ent minpoint maxpoint oEcho)
(vl-load-com)
(setq oEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)
  (setq
    t2f (getstring t "\nChuoi can tim (ket thuc bang enter):")
    sss (ssget "X" (list (cons 0 "TOLERANCE") 
(cons 1 (strcat "*" (if (= (substr t2f 1 1) "*") "*" "%%v")  t2f 
    (if (= (substr t2f (strlen t2f) 1) "*") "*" "%%v") "*" ))))        
    lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss)))
  )
 
(alert (strcat "\nTim thay " (itoa (length lst)) " doi tuong!"))  
(foreach ent lst
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
 (setq minpoint (vlax-safearray->list minpoint) 
  maxpoint (vlax-safearray->list maxpoint))
    (command ".zoom" minpoint maxpoint)
    (command ".zoom" "0.5xp")    
    (getstring "\nNhan enter hoac spacebar de tiep tuc!")
  )
(setvar "cmdecho" oEcho)
  (princ)
)

<<

Filename: 253149_fz.lsp
Tác giả: Skywings
Bài viết gốc: 252524
Tên lệnh: test2
Biện pháp tăng tốc độ trong các chương trình Lisp

vùng chọn cũng thế thôi

Nếu bạn bỏ qua Z từ đầu tức là đã có thể "sót nghiệm" :D

Sót là sót thế nào  :huh: ? Có lẽ bạn chưa hiểu ý mình. Nếu bạn cũng cho rằng SSGET ko thể chọn tập điểm 3d thì hãy thử code mình post ở bài #15 nhé, xem có lọt điểm 3d nào trong vùng chọn...

>>

vùng chọn cũng thế thôi

Nếu bạn bỏ qua Z từ đầu tức là đã có thể "sót nghiệm" :D

Sót là sót thế nào  :huh: ? Có lẽ bạn chưa hiểu ý mình. Nếu bạn cũng cho rằng SSGET ko thể chọn tập điểm 3d thì hãy thử code mình post ở bài #15 nhé, xem có lọt điểm 3d nào trong vùng chọn ko?!

 

@Gia_Bach: cám ơn bác up đoạn code phun điểm random để test thử. Theo mình thì dùng "vl-sort" sẽ mất rất nhiều thời gian để sort điểm tăng dần hay giảm dần, trong khi mục đích chỉ là tìm MIN. Mình dùng phương pháp tìm MIN cổ điển, cũng duyệt qua toàn bộ selection nhưng thời gian ngắn hơn nhiều phương pháp dùng "vl-sort".

 

Mình test với 105000 điểm phun từ hàm Random của bác Gia_Bach:

- vl-sort:    5.7190 secs

- classico: 1.9840 secs.

 

(defun c:test2 (/ CLOSESTPNT DIS DISMIN I N PNT PT SS ST)
  (setq	pt (getpoint "pick point")
	ss (ssget "_x" '((0 . "point")))
	i  -1
	st (getvar 'millisecs)
  )
  ;; Skywings
  (setq	closestPnt (cdr (assoc 10 (entget (ssname ss 0))))
	disMin	   (distance pt closestPnt)
  )
  (setq n 1)
  (if ss
    (repeat (- (sslength ss) 1)
      (setq pnt	(cdr (assoc 10 (entget (ssname ss n))))
	    dis	(distance pt pnt)
	    n	(1+ n)
      )
      (if (< dis disMin)
	(setq disMin dis
	      closestPnt pnt
	)
      )
    )
  )
  (entmakex
    (list '(0 . "LINE") (cons 10 pt) (cons 11 closestPnt))
  )
  (princ
    (strcat "\nProgram running time: "
	    (rtos (/ (- (getvar 'millisecs) st) 1000.) 2 4)
	    " msecs."
    )
  )
  (princ)
)

<<

Filename: 252524_test2.lsp
Tác giả: Tue_NV
Bài viết gốc: 253552
Tên lệnh: nent
Hàm ssget trong Autolisp

Mình có thêm một thắc mắc về hàm ssget nữa.
Khi dùng (nentsel) để pick vào một text bên trong Block, nó sẽ trả về giá trị của text đơn mà không quan tâm đến block.
Vậy làm sao để chọn được block chứa nó sau 1 lần pick? Và khi sử dụng (nentsel), làm sao để biết mình đã pick vào một...

>>

Mình có thêm một thắc mắc về hàm ssget nữa.
Khi dùng (nentsel) để pick vào một text bên trong Block, nó sẽ trả về giá trị của text đơn mà không quan tâm đến block.
Vậy làm sao để chọn được block chứa nó sau 1 lần pick? Và khi sử dụng (nentsel), làm sao để biết mình đã pick vào một block?

 

Bạn tham khảo code này:

(defun c:nent (/ e)
(setq e (nentsel "\n Pick vao doi tuong :"))
(if (= (type (car (last e))) 'ENAME)
 (progn
   (alert "Ban dang pick vao Block")
  (setq e (car (last e)))  
))
 e
)

<<

Filename: 253552_nent.lsp
Tác giả: duy782006
Bài viết gốc: 34368
Tên lệnh: textfitm
Xin các pác viết dùm lisp ở lệnh text fit


Lệnh là TEXTFITM.
-Vì áp dụng cho nhiều text nên tiện ích không tự nhận điểm đầu tiên mà bạn phải chọn cả điểm bắt đầu và kết thúc (nhập giá trị độ dài bằng số cũng được).
-Tiện ích chỉ thay đổi độ rộng các dòng text bằng với khoảng độ dài mới (chọn 2 điểm hoặc nhập giá trị số) còn lại điểm canh lề thứ nhất và góc quay vẫn giữ nguyên.
>>


Lệnh là TEXTFITM.
-Vì áp dụng cho nhiều text nên tiện ích không tự nhận điểm đầu tiên mà bạn phải chọn cả điểm bắt đầu và kết thúc (nhập giá trị độ dài bằng số cũng được).
-Tiện ích chỉ thay đổi độ rộng các dòng text bằng với khoảng độ dài mới (chọn 2 điểm hoặc nhập giá trị số) còn lại điểm canh lề thứ nhất và góc quay vẫn giữ nguyên.


<<

Filename: 34368_textfitm.lsp
Tác giả: girl
Bài viết gốc: 241022
Tên lệnh: jff
Lisp chuyển Line sang PL !

Vâng, anh có cho em xin cái EXplode,

cảm ơn anh đã gợi ý, em làm được rồi : 

(defun C:jff() 
(SETQ SS (SSGET)) 
(command ".pedit" "M" ss "" "Y" "X" "")
(princ)
)


Filename: 241022_jff.lsp

Trang 142/301

142