Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#1041 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 08 April 2010 - 04:48 PM

tôi có một yêu cầu nhỏ này mong mọi người giúp:Tôi có một vùng được khoanh bằng poly,tôi muốn tạo ra một mạng lưới tam giác khép kín gồm các tam giác nhỏ vẽ bằng poly,các cạnh tam giác chẳn do mình đặt chiều dài,còn các cạnh tam giác lẻ(tam giác nằm ở viền) tuỳ biến.kết quả giống file tôi gời http://www.cadviet.c...drawing1_25.dwg

Chào Thonghoang1, Lisp này này thiep đã viết xong, nhưng sau khi thử trên Cad2007 thì nó không chạy không đúng. Vì vậy, yêu cầu dùng lisp là:
- Từ cad 2008 trở lên có cài Express tools
- Copy dòng mã sau vào file acad.pat:
*AutoTri, Trianglular spacing
0, 0,0, 0.5,0.866025404, 0,-1

Và đây là lisp luoitamgiac.lsp, lệnh là 3nt:
;;; Thank Daniele Piazza, ADN member Mechanical Solution s.r.l.		;
;;; Phat trien boi Tran Thiep 03/2010
(defun flagoff (lstpo / dt i flag)
(setq dt 0.0
i 0)
(setq lstpo (append lstpo (list (car lstpo))))
(repeat (- (length lstpo) 1)
(setq dt (+ dt
(- (* (car (nth i lstpo)) (cadr (nth (1+ i) lstpo)))
(* (cadr (nth i lstpo)) (car (nth (1+ i) lstpo)))
)
)
)
(setq i (1+ i))
)
(If (minusp dt)
(setq flag (- vwsz))
(setq flag vwsz)
)
flag
)
;;;--------------------------------
(defun cent (ent / tria)
(setq tria (ACET-GEOM-VERTEX-LIST ent))
(if (eq (car tria) (last tria))
(setq tria (cdr tria))
)
(list (/ (apply '+ (mapcar 'car tria)) 3)
(/ (apply '+ (mapcar 'cadr tria)) 3)
(/ (apply '+ (mapcar 'caddr tria)) 3)
)
)
;;;-----------------------------
(defun Arrhat (obj / Arr L)
(setq L (cons obj L))
(setq Arr (vlax-make-safearray
vlax-vbObject
(cons 0 (1- (length L)))
)
)
(vlax-safearray-fill Arr L)
)
;;;--------------------------
(defun addpo (po / obj)
(vla-put-layer
(setq obj (vla-addpoint *Model* (vlax-3d-point po)))
"LA_THIEP"
)
(vlax-vla-object->ename obj)
)
;;;------------------------
(defun GETCIRCIRCUMCIRCLE (triangle / centpo)
(setq centpo (apply 'acet-geom-arc-center TRIANGLE))
(list centpo (distance centpo (car TRIANGLE)))
)
;;;------------------------
(defun ISINSIDE (pt circle)
(setq ctr (car circle)
rad (cadr circle)
)
(< (distance pt ctr) rad)
)
;;;Search the supertriangle that contain all points in the data set;
(defun FINDSUPERTRIANGLE (ptlst / xmax xmin ymax ymin
zmax zmin dx dy dmax
xmid ymid trx1 trx2 trx3
try1 try2 try3 trz1 trz2
trz3
)
(setq xmax (apply 'max (mapcar 'car ptlst))
xmin (apply 'min (mapcar 'car ptlst))
ymax (apply 'max (mapcar 'cadr ptlst))
ymin (apply 'min (mapcar 'cadr ptlst))
dx (- xmax xmin)
dy (- ymax ymin)
dmax (max dx dy)
xmid (* (+ xmax xmin) 0.5)
ymid (* (+ ymax ymin) 0.5)
trx1 (- xmid (* dmax 2.0))
try1 (- ymid dmax)
trz1 0.0
trx2 xmid
try2 (+ ymid dmax)
trz2 0.0
trx3 (+ xmid (* dmax 2.0))
try3 (- ymid dmax)
trz3 0.0
)
(list (list trx1 try1 trz1)
(list trx2 try2 trz2)
(list trx3 try3 trz3)
)
)
;;; add triangle edges at the edge queue;
(defun ADDTRIANGLEEDGES (triangle edgelst)
(append edgelst
(list (list (car triangle) (cadr triangle))
(list (cadr triangle) (caddr triangle))
(list (caddr triangle) (car triangle))
)
)
)
;;; the fun side if the algorithm. Draw triangulation.;
(defun DRAWTRIANGLE (triangle / obj)
(ACET-LWPLINE-MAKE (list triangle))
(setq obj (vlax-ename->vla-object (entlast)))
(vla-put-Closed obj t)
(vla-put-Layer obj "LA_THIEP")
)

;;; Test the edge queue to remove duplicates (warning CW & CCW!);
;;; ;

(defun REMOVEDOUBLYEDGES (edgelst fuzzy nulllist / i k)
(setq j 0)
(while (< j (length edgelst))
(setq k (1+ j))
(while (< k (length edgelst))
(if
(or
(and
(equal (car (nth j edgelst)) (car (nth k edgelst)) fuzzy)
(equal (cadr (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
)
(and (equal (car (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
(equal (cadr (nth j edgelst)) (car (nth k edgelst)) fuzzy)
)
)
(setq edgelst (nth_subst j nulllist edgelst)
edgelst (nth_subst k nulllist edgelst)
)
)
(setq k (1+ k))
)
(setq j (1+ j))
)
edgelst
)

;;; Add new triangle generated by pt to triangle list.;
;;; ;

(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle)
(setq j 0)
(while (< j (length edgelst))
(if (nth j edgelst)
(setq triangle (cons pt (nth j edgelst))
trianglelst (cons (list triangle nil) trianglelst)
)
)
(setq j (1+ j))
)
trianglelst
)


;;; delete the n item in the list (by position, not by value!!) ;
(defun NTH_DEL (N LST / l)
(repeat n
(setq l (cons (car lst) l)
lst (cdr lst)
)
)
(append (reverse l) (cdr lst))
)
;;; Replace the index element in the list with new element. This function is ;
;;; recursive this is not a great solution with a large amount of data. ;
(defun NTH_SUBST (index new Alist)
(cond
((minusp index) Alist)
((zerop index) (cons new (cdr Alist)))
(T
(cons (car Alist) (nth_subst (1- index) new (cdr Alist)))
)
)
)
;;;-------------------------
(defun Text (*Model* str po H / obj)
(setq obj (vla-AddText
*Model*
str
(vlax-3d-point po)
h
)
)
(vla-put-Alignment obj acAlignmentmiddleCenter)
(vla-put-TextAlignmentPoint obj (vlax-3d-point po))
)
;;;---------------------
(defun DXF (code name) (cdr (assoc code (entget name))))
;;;======================MAIN===================================================
=
(defun c:3nt (/ cmdo doc *Model* *layer* addH entlwp
objlwp arr hat vwsz ss lstent
lstpolwp lstentpo fuzzy nulllist ss1
ptlst nv supertriangle trianglelst
i j k edgelst circle
pt flag lstLWp1 objLW1 disoff
lstent_tg H
)
(command "undo" "be")
(vl-load-com)
(setq cmdo (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object)
)
*Model* (vla-get-modelspace doc)
*layer* (vla-get-Layers Doc)
addH (vla-AddHatch
*Model* acHatchPatternTypePredefined
"AutoTri" T
AcHatchObject
)
)
(OR (tblobjname "layer" "LA_THIEP")
(vla-add *layer* "LA_THIEP")
)
(setq entlwp (car (entsel "\nPick a object LWP:"))
lstpolwp (ACET-LIST-REMOVE-DUPLICATES
(ACET-GEOM-VERTEX-LIST entlwp)
0
)
objlwp (vlax-ename->vla-object entlwp)
arr (arrhat objlwp)
)
(setq vwsz (* (getvar "viewsize") 0.005))
(vlax-invoke-method addH 'AppendOuterLoop arr)
(setq D (cond (D)
(5)
)
)
(setq oldD D)
(setq D (getreal (strcat "\nChon kich thuoc canh tam giac <"
(rtos oldD 2 0)
"> : "
)
)
)
(if (null D)
(setq D oldD)
)
(setq goc (cond (goc)
(0)
)
)
(setq oldgoc goc)
(setq goc (getreal (strcat "\nChon goc quay canh tam giac (do) <"
(rtos oldgoc 2 2)
"> : "
)
)
)
(if (null goc)
(setq goc oldgoc)
)
(vla-put-PatternScale addH D)
(vla-put-PatternAngle addH (/(* goc pi)180))
(vla-update addH)
(command ".explode" (entlast))
(setq ss (ssget "P" '((0 . "LINE")))
lstent (acet-ss-to-list ss)
ptlst (mapcar '(lambda (x) (DXF 10 x))
lstent
)
)
(mapcar '(lambda (x) (setq lstentpo (cons (addpo x) lstentpo))) ptlst)
(mapcar 'entdel lstent)

;;;=================================================

(setq fuzzy 1e-8
nulllist nil
)
(setq ptlst (append lstpolwp
(mapcar '(lambda (x) (DXF 10 x)) lstentpo)
)
ptlst (vl-sort ptlst
'(lambda (x y)
(< (car x) (car y))
)
)
nv (length ptlst)
supertriangle (findsupertriangle ptlst)
ptlst (append ptlst supertriangle)
;append coordinates to the end of vertex list
trianglelst (list (list supertriangle nil))
;add supertriangle to the triangle list
)
(setq i 0)
(ACET-UI-PROGRESS "=> => XUNG PHONG => =>" nv)
(while (< i nv)
(setq pt (nth i ptlst))
;;; initialize edge buffer
(setq edgelst nil)
(setq j 0)
(while (and trianglelst
(setq triangle (car (nth j trianglelst)))
)
(setq flag t)
(if (not (cadr (nth j trianglelst)))
(progn
;;; calculate circumcircle
(setq circle (getcircircumcircle triangle))
;;; test point x and (pt) location
(if (< (+ (caar circle) (cadr circle)) (car pt))
(setq trianglelst
(nth_subst j
(list (car (nth j trianglelst)) T)
trianglelst
)
)
)
(if (isinside pt circle)
(setq edgelst (addtriangleedges triangle edgelst)
trianglelst (ACET-LIST-REMOVE-NTH j trianglelst);(nth_del j trianglelst)
flag nil
)
)
)
)
(if flag
(setq j (1+ j))
)
)
;;; remove all doubly specified edges
(setq edgelst (removedoublyedges edgelst fuzzy nulllist))
;;; form new triangles for current point
(setq trianglelst (addnewtriangles pt edgelst trianglelst))
;;; get next vertex
(setq i (1+ i))
(ACET-UI-PROGRESS -1)
)
(ACET-UI-PROGRESS)
(setq trianglelst (mapcar 'car trianglelst)
disoff (flagoff lstpolwp))
(setq objLW1 (car (vlax-safearray->list
(vlax-variant-value (vla-offset objlwp disoff))
)
)
)
(ACET-UI-PROGRESS "TAN CONG !!!" (length trianglelst))
(foreach triangle trianglelst
(drawtriangle triangle)
(ACET-UI-PROGRESS -1)
)
(ACET-UI-PROGRESS)
;;; remove triangles with supertriangles edges

(setq lstLWp1 (ACET-GEOM-VERTEX-LIST (vlax-vla-object->ename objLW1))
lstendel (acet-ss-to-list
(ssget "F"
lstLWp1
'((0 . "LWPOLYLINE") (8 . "LA_THIEP"))
)
)
)
(mapcar 'entdel lstendel)
(mapcar 'entdel lstentpo)
(vla-Delete objLW1)
(setq lstent_tg (acet-ss-to-list
(ssget "CP"
lstpolwp
'((0 . "LWPOLYLINE") (8 . "LA_THIEP"))
)
)
ptlst (mapcar 'cent lstent_tg)
ptlst (vl-sort ptlst
'(lambda (x y)
(> (caDr x) (caDr y))
)
)
i 1
H (* D 0.1)
)
(foreach po ptlst
(Text *Model* (itoa i) po H)
(setq i (1+ i))
)
(setq Summ (vla-get-SummaryInfo doc))
(vla-put-Comments summ "Thank you for use luoitamgiac.lsp!")
(vla-put-Author summ "By TranThiep 0918841230")
(vla-put-HyperlinkBase summ "http://www.cadviet.com")
(command "undo" "en")
(vla-regen doc acAllViewports)
(princ)
)

Xin cảm ơn Daniele Piazza, ADN member Mechanical Solution s.r.l.
  • 0

#1042 anh.tuan

anh.tuan

    biết lệnh extend

  • Members
  • PipPipPip
  • 196 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 08 April 2010 - 08:42 PM

Các bác có thể viết giúp mìn lisp vát hai đường thẳng giao nhau theo những khoảng D1, D2 mà mình chọn, lisp này giống như lệnh chamfer của cad. Các đường thẳng ở đây là line, polyline. Cám ơn các bác nhiều.
  • 0

#1043 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 08 April 2010 - 11:05 PM

Chân thành cảm ơn bác ssq đã quan tâm đến mong muốn của em.
Thực ra, mong muốn của em không đến mức sâu xa như bác đã đề cập đâu. Ở đây, điều em quan tâm là khả năng thống kê (ví dụ như số lượng, vật liệu, kích thước phôi, ...) của các bản vẽ mà thôi chứ không cần phải liên kết bền chặt mọi yếu tố. Nếu bác đã xem qua một ví dụ của em, bác sẽ thấy có phần bảng thống kê ở phía trên khung tên và ở file thống kê chung PARTLIST. Em muốn hỏi liệu chúng ta có thể tạo sự liên kết giữa chúng hay không? Em giả sử trong file BV01 (Bản vẽ lắp) số lượng các chi tiết không phải như trong hình vẽ đó nữa mà có thể tăng hoặc giảm, thì làm cách nào đó, số lượng trong bản PARTLIST cũng sẽ thay đổi theo. Hoặc như, vật liệu chế tạo, kích thước phôi trong các bản vẽ chi tiết BV02, BV03 có sự thay đổi thì bằng cách nào đó, sự thống kê trong bản vẽ lắp và bản thống kê chung cũng sẽ cập nhật được những thông tin này.
Mong muốn của em là như vậy, mong các bác nghiên cứu giúp em xem liệu AutoCAD, với sự giúp đỡ của autolisp hay VBA có thể giải quyết được điều em mong muốn hay không?
Rất cảm ơn các bác trong diễn đàn đã quan tâm.
Chúc các bác luôn mạnh khoẻ và vui vẻ!

Nếu bạn bố trí các bản vẽ trong cùng 1 file *.dwg thì xem các bài ở đây:
http://www.cadviet.c...?showtopic=1515
và:
http://www.cadviet.c...o...=13131&st=0
Còn ở các file khác nhau thì ssg bó tay!
  • 1

#1044 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 09 April 2010 - 04:58 PM

Cảm ơn Tuệ, Thiep bận rộn cả ngày hôm qua, Tuệ đã tiếp tay rất nhanh cho Tuynh.
Thiep chỉ gợi ý Tue rằng có 1 hàm trong thư viện Express tools tạo POLYLINE rất nhanh, đó là: acet-pline-make.
Còn lisp trên, Tuynh hãy đợi Tue_NV sẽ thêm vòng lặp để chọn đối tượng đến khi enter thì thôi

Ngày trước mình có yêu cầu lisp chuyển đường 2d polyline thành đường 3d polyline và được bác Tuệ và bác Thiệp giúp đỡ có một lisp.
(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x ss oldos)
(vl-load-com)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq curve (car(entsel "\n Pick chon POlyline 2D hoac Polyline 3D :")))
(setq pre (vlax-curve-getEndParam curve) i 0 lstdiem '() lstpoint '() ss (ssadd))
(setq cao (getdist "\n Chon chieu cao chu :"))

(while (<= i pre)
(setq p (vlax-curve-getPointAtParam curve i))
(setq lstdiem (append lstdiem (list p)))
(wtxt (rtos (caddr p) 2 2) p 0 cao)
(setq ss (ssadd (entlast) ss))
(setq i (1+ i))
)

(setq i 0)
(foreach x lstdiem
(setq z (getdist x (strcat "\n Nhap cao do cho diem nay <" (rtos (caddr x) 2 2) "> : ") ))
(setq lstpoint (append lstpoint (list(list (car x) (cadr x) z))))
(wtxt (rtos z 2 2) (list (car x) (cadr x) z) 0 cao)
(entdel (ssname ss i))
(setq i (1+ i))
)

(command "3dpoly")
(foreach y lstpoint (command y))
(command "")
(entdel curve)
(setvar "osmode" oldos)
(princ)
)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty)
(cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 1) (cons 50 ang)
(cons 40 h) (cons 41 0.8))
)
)
các bác có thể chỉnh sửa lisp trên để khi chỉnh sửa text thì cao độ ở đường 3d polyline cũng thay đổi theo.
cảm ơn các bác trước nhé!
  • 0

#1045 thonghoang1

thonghoang1

    biết vẽ polygon

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

Đã gửi 10 April 2010 - 11:09 AM

cảm ơn bạn thiếp đã giúp mình,mình chưa dùng được vì may mình không cài được acad 2008,máy yếu quá mà.mình chỉ có 2007 thôi.hix
  • 0

#1046 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 10 April 2010 - 08:15 PM

Bác Tuệ đang online ạ, bác giúp em sửa lại lisp chuyển đường 2d poly thành đường 3d poly là khi chỉnh giá trị của text thì cao độ đường 3d poly cũng thay đổi theo đó.
  • 0

#1047 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 11 April 2010 - 09:52 PM

Ngày trước mình có yêu cầu lisp chuyển đường 2d polyline thành đường 3d polyline và được bác Tuệ và bác Thiệp giúp đỡ có một lisp.
(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x ss oldos)(vl-load-com)(setvar "orthomode" 0)(setvar "cmdecho" 0)(setq oldos (getvar "osmode"))(setvar "osmode" 0)(setq curve (car(entsel "\n Pick chon POlyline 2D hoac Polyline 3D :")))(setq pre (vlax-curve-getEndParam curve) i 0 lstdiem '() lstpoint '() ss (ssadd))(setq cao (getdist "\n Chon chieu cao chu :"))(while (<= i pre)(setq p (vlax-curve-getPointAtParam curve i))(setq lstdiem (append lstdiem (list p)))(wtxt (rtos (caddr p) 2 2) p 0 cao)(setq ss (ssadd (entlast) ss))(setq i (1+ i)))(setq i 0)(foreach x lstdiem(setq z (getdist x (strcat "\n Nhap cao do cho diem nay <" (rtos (caddr x) 2 2) "> : ") ))(setq lstpoint (append lstpoint (list(list (car x) (cadr x) z))))(wtxt (rtos z 2 2) (list (car x) (cadr x) z) 0 cao)(entdel (ssname ss i))(setq i (1+ i)))(command "3dpoly")(foreach y lstpoint (command y))(command "")(entdel curve)(setvar "osmode" oldos)(princ));(defun wtxt (txt p ang h / sty)(setq sty (getvar "textstyle"))(entmake (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 11 p) (cons 72 2) (cons 73 1) (cons 50 ang) (cons 40 h) (cons 41 0.8))))
các bác có thể chỉnh sửa lisp trên để khi chỉnh sửa text thì cao độ ở đường 3d polyline cũng thay đổi theo.
cảm ơn các bác trước nhé!

Code mà Tue_NV viết cho Tuynh khi xưa đẹp là thế. Cớ sao bây chừ lại "nông lỗi" như thế lày? :undecided:

Có 2 Lisp lận chứ không phải có 1 Lisp đâu Tuyn. Tue_NV đã giúp cho Tuynh 2 code Lisp. 1 Lisp ghi cao độ . Và sửa cao độ Text và cả 2 Lisp này áp dụng được cho cả POLYLINE và 3DPOLY. Tuyn kiểm tra lại
  • 0

#1048 nvngoc1986

nvngoc1986

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 11 April 2010 - 11:32 PM

Các bác ơi cho em hỏi có Lisp nào làm được thế này ko : Em cần quét một dãy các số ( theo trục X , hoặc Y ) , sau đó xuất ra file text ( em toàn phải gõ từng số sang bên Excel ) mà thứ tự vẫn theo hảng cột như trên bản vẽ !
Cảm ơn các bác .
  • 0

#1049 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 12 April 2010 - 02:31 AM

Code mà Tue_NV viết cho Tuynh khi xưa đẹp là thế. Cớ sao bây chừ lại "nông lỗi" như thế lày? :undecided:

Có 2 Lisp lận chứ không phải có 1 Lisp đâu Tuynh. Tue_NV đã giúp cho Tuynh 2 code Lisp. 1 Lisp ghi cao độ . Và sửa cao độ Text và cả 2 Lisp này áp dụng được cho cả POLYLINE và 3DPOLY. Tuynh kiểm tra lại

Thành thật xin lỗi bác Tue_NV
Chả hiểu sao khi em copy, paste Code lại nhảy ra kiểu thế, do vội quá em không để ý bác đừng bùn nhé.
Em đã tìm thấy lisp thứ hai rùi ạ.
Chúc Tue_NV sức khỏe nhé.
  • 0

#1050 quangtvxd

quangtvxd

    biết zoom

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

Đã gửi 12 April 2010 - 10:11 AM

Không có ai quan tâm giúp đỡ em việc này sao? Giúp em với các bác hảo tâm ơi

mình nghĩ bạn có thể insert block theo dạng file rồi phá block đó đi, là cũng nhanh rồi đó.
  • 0

#1051 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 12 April 2010 - 10:32 AM

Chào các bác trên diễn đàn, nhờ các bác viết hộ đoạn mã dùng để áp dụng đoạn lệnh sau ko lỗi:
(c:cal "chuoi phep tinh")

Khi chuỗi phép tính là các số nguyên lớn thì hàm chạy sai hoặc không hiểu (ex: "1000000*2000000+3000000/4000000-5000000")

Cảm ơn các bác trước, mong hồi âm.
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1052 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 12 April 2010 - 10:33 AM

Ngày trước mình có yêu cầu lisp chuyển đường 2d polyline thành đường 3d polyline và được bác Tuệ và bác Thiệp giúp đỡ có một lisp.
(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x ss oldos)
(vl-load-com)
............................
)
các bác có thể chỉnh sửa lisp trên để khi chỉnh sửa text thì cao độ ở đường 3d polyline cũng thay đổi theo.
cảm ơn các bác trước nhé!

Chào Tuynh, Thiep xin góp 1 lisp update các cao độ các nút của 3Dpoly theo text độ cao của các nút đã chỉnh sữa.
Thuật toán của lisp là tìm ứng với mỗi text số nào gần nút của 3Dpoly nhất sẽ update cho cao độ ứng với nút ấy.
;; free lisp from cadviet.com
;;; Lisp update do cao cho các nút cua 3DOPLY
;;; BY Thiep 03/2010
;;; yeu cau: cài dat express tools
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;------------------------------------
(defun timgan (p lst / dmin ensave p2 d)
(foreach l lst
(setq p2 (car l)
d (distance p p2)
)
(if (or (not dmin) (> dmin d))
(setq dmin d
ensave l
)
)
)
ensave
)
;;;---------------------------------
(defun 3DPoly (Lp *ModelSpace* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-Add3Dpoly *ModelSpace* PntArr)
)
;;;--------------------------------
(defun c:u3dp (/ ss lstentext olsmd entPL lstent
lstentext hei Lstnum lstpo lsp p1
)
(or ActDoc
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *Model* (setq *Model* (vla-get-ModelSpace ActDoc)))
(setq olsmd (getvar "OSMODE"))
(setvar "osmode" 0)
(command "undo" "be")
(setq lstent (acet-ss-to-list (ssget '((0 . "TEXT,POLYLINE")))))
(foreach ent lstent
(if (eq (dxf 0 ent) "TEXT")
(setq lstentext (cons ent lstentext))
(setq entPL ent)
)
)
(foreach ent lstentext
(setq po (dxf 10 ent)
hei (distof (dxf 1 ent))
)
(if hei
(setq Lstnum (cons (cons po hei) Lstnum))
)
)
(setq lstpo (acet-geom-vertex-list entPL)
lsp nil
)
(foreach po lstpo
(setq p1 (timgan po Lstnum)
lsp (append (list (car po) (cadr po)) (list (cdr p1)) lsp)
)
)
(foreach ent lstentext
(setq po (dxf 10 ent))
(vla-put-InsertionPoint
(vlax-ename->vla-object ent)
(vlax-3d-point
(list (car po) (cadr po) (distof (dxf 1 ent)))
)
)
)
(entdel entPL)
(3DPoly lsp *Model*)
(command "undo" "en")
(setvar "osmode" olsmd)
(princ "\nChuc ban thanh cong! Thiep.")
(princ)
)


Chào mọi người, tôi muốn tìm một đối tượng nằm gần nhất 1 điểm nào đó thì phải làm thế nào?
Rất mong mọi người chỉ giúp.
Trân trọng cảm ơn.

Chào hoaletrang, bạn có thể tham khảo hàm con timgan ở lisp trên, hàm này Thiep cũng tham khảo từ bác Hoanh.
  • 2

#1053 hoaletrang

hoaletrang

    biết vẽ line

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

Đã gửi 12 April 2010 - 12:11 PM

Chào hoaletrang, bạn có thể tham khảo hàm con timgan ở lisp trên, hàm này Thiep cũng tham khảo từ bác Hoanh.

Cảm ơn bạn, nhưng ý của tôi là nó tự tìm trong bản vẽ, nếu bản vẽ có ít đối tượng thì chọn select all cũng được nhưng với bản vẽ lớn mà làm nhẽ chạy rất lâu.
  • 0

#1054 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 12 April 2010 - 12:19 PM

Cảm ơn bạn, nhưng ý của tôi là nó tự tìm trong bản vẽ, nếu bản vẽ có ít đối tượng thì chọn select all cũng được nhưng với bản vẽ lớn mà làm nhẽ chạy rất lâu.

Đúng là nó sẽ chạy rất lâu khi có số lượng lớn các đối tượng. Nhưng nếu bạn ước đoán trước phạm vi bán kính tối thiểu cần tìm thì nó sẽ chạy rất nhanh. Bạn hãy post lên 1 bản vẽ ví dụ xem, tôi có cách giúp bạn.
  • 0

#1055 hoaletrang

hoaletrang

    biết vẽ line

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

Đã gửi 12 April 2010 - 12:30 PM

Không cần gửi dwg lên đâu vì mục đích rất đơn giản thôi, giả sử ta có 1 điểm cho trước, bây giờ muốn vẽ 1 line từ điểm đó đến điểm chèn (basepoint) của một đối tượng gần nhất. Thậm chí tôi còn đang muốn tìm đường biên gần nhất của 1 đối tượng nào đó.
Vấn đề ở đây tôi nghĩ là thuật toán, có lẽ nó gần giống như việc tìm đường đi ngắn nhất, tuy nhiên trong Cad quá phức tạp, chắc trong cad sẽ có 1 chức năng như thế nhưng ẩn dấu ở đâu đó mà ta chưa biết.
À quên, tất cả đều phải tự động, không có thao tác bằng tay.
  • 0

#1056 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 12 April 2010 - 12:45 PM

thanks! :undecided:
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#1057 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 12 April 2010 - 06:27 PM

Chào Tuynh, Thiep xin góp 1 lisp update các cao độ các nút của 3Dpoly theo text độ cao của các nút đã chỉnh sữa.
Thuật toán của lisp là tìm ứng với mỗi text số nào gần nút của 3Dpoly nhất sẽ update cho cao độ ứng với nút ấy.

;; free lisp from cadviet.com
;;; Lisp update do cao cho các nút cua 3DOPLY
;;; BY Thiep 03/2010
;;; yeu cau: cài dat express tools
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;------------------------------------
(defun timgan (p lst / dmin ensave p2 d)
(foreach l lst
(setq p2 (car l)
d (distance p p2)
)
(if (or (not dmin) (> dmin d))
(setq dmin d
ensave l
)
)
)
ensave
)
;;;---------------------------------
(defun 3DPoly (Lp *ModelSpace* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-Add3Dpoly *ModelSpace* PntArr)
)
;;;--------------------------------
(defun c:u3dp (/ ss lstentext olsmd entPL lstent
lstentext hei Lstnum lstpo lsp p1
)
(or ActDoc
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *Model* (setq *Model* (vla-get-ModelSpace ActDoc)))
(setq olsmd (getvar "OSMODE"))
(setvar "osmode" 0)
(command "undo" "be")
(setq lstent (acet-ss-to-list (ssget '((0 . "TEXT,POLYLINE")))))
(foreach ent lstent
(if (eq (dxf 0 ent) "TEXT")
(setq lstentext (cons ent lstentext))
(setq entPL ent)
)
)
(foreach ent lstentext
(setq po (dxf 10 ent)
hei (distof (dxf 1 ent))
)
(if hei
(setq Lstnum (cons (cons po hei) Lstnum))
)
)
(setq lstpo (acet-geom-vertex-list entPL)
lsp nil
)
(foreach po lstpo
(setq p1 (timgan po Lstnum)
lsp (append (list (car po) (cadr po)) (list (cdr p1)) lsp)
)
)
(foreach ent lstentext
(setq po (dxf 10 ent))
(vla-put-InsertionPoint
(vlax-ename->vla-object ent)
(vlax-3d-point
(list (car po) (cadr po) (distof (dxf 1 ent)))
)
)
)
(entdel entPL)
(3DPoly lsp *Model*)
(command "undo" "en")
(setvar "osmode" olsmd)
(princ "\nChuc ban thanh cong! Thiep.")
(princ)
)

Chào hoaletrang, bạn có thể tham khảo hàm con timgan ở lisp trên, hàm này Thiep cũng tham khảo từ bác Hoanh.

Chào Thiep, Tuynh chạy thử lisp của Thiep nhưng sau khi chạy lisp thì cao độ các đỉnh 3d Polyline lại trở về 0.00 hết Thiep giúp mình xem lại lisp được không?
Cảm ơn Thiep nhé.
  • 0

#1058 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1432 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 13 April 2010 - 08:17 AM

Không cần gửi dwg lên đâu vì mục đích rất đơn giản thôi, giả sử ta có 1 điểm cho trước, bây giờ muốn vẽ 1 line từ điểm đó đến điểm chèn (basepoint) của một đối tượng gần nhất. Thậm chí tôi còn đang muốn tìm đường biên gần nhất của 1 đối tượng nào đó.
Vấn đề ở đây tôi nghĩ là thuật toán, có lẽ nó gần giống như việc tìm đường đi ngắn nhất, tuy nhiên trong Cad quá phức tạp, chắc trong cad sẽ có 1 chức năng như thế nhưng ẩn dấu ở đâu đó mà ta chưa biết.
À quên, tất cả đều phải tự động, không có thao tác bằng tay.

Cách chọn đối tuơng từ 1 điểm cho truớc. (Trong t/hợp bản vẽ lớn)

p0 : là điểm cho truớc.
delta : buớc nhảy
p1 = (polar p0 x y) ; vị trí cao nhất bên phải cửa sổ
p2 = (polar p0 -x -y) ; vị trí thấp nhất bên trái cửa sổ

(while (null (ssget "_C" p1 p2 ) )
x= x + delta ; tăng k/thuớc phuơng ngang cửa sổ
y= y + delta ; tăng k/thuớc phuơng đứng cửa sổ
p1 = (polar p0 x y)
p2 = (polar p0 -x -y) )


Sau khi chọn đuợc đối tuợng, gọi hàm TìmGần như đề nghị của thiep
  • 0

#1059 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 13 April 2010 - 11:36 AM

Chào Thiep, Tuynh chạy thử lisp của Thiep nhưng sau khi chạy lisp thì cao độ các đỉnh 3d Polyline lại trở về 0.00 hết Thiep giúp mình xem lại lisp được không?
Cảm ơn Thiep nhé.

Khi máy báo "Select objects:", Bạn phải chọn cả đối tượng polyline và text cao độ.
Bạn chép đoạn mã nhắc nhở: (prompt "\nChon doi tuong 3DPOLYLINE & TEXT cao do:")
vào trước dòng: (setq lstent (acet-ss-to-list (ssget '((0 . "TEXT,POLYLINE"))))).
Chúc Tuynh thành công.

Cách chọn đối tuơng từ 1 điểm cho truớc. (Trong t/hợp bản vẽ lớn)

p0 : là điểm cho truớc.
delta : buớc nhảy
p1 = (polar p0 x y) ; vị trí cao nhất bên phải cửa sổ
p2 = (polar p0 -x -y) ; vị trí thấp nhất bên trái cửa sổ

(while (null (ssget "_C" p1 p2 ) )
x= x + delta ; tăng k/thuớc phuơng ngang cửa sổ
y= y + delta ; tăng k/thuớc phuơng đứng cửa sổ
p1 = (polar p0 x y)
p2 = (polar p0 -x -y) )


Sau khi chọn đuợc đối tuợng, gọi hàm TìmGần như đề nghị của thiep

Gia Bach rất hiểu ý Thiep, delta : ở đây Thiep cho đó là bán kính tối thiểu, tùy theo từng bản vẽ người dùng sẽ ước lượng bán kính này. Thiep cũng chưa hiểu đối tượng cần tìm là đối tượng gì, thiep đang chờ 1 ví dụ cụ thể
  • 1

#1060 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 13 April 2010 - 03:55 PM

Khi máy báo "Select objects:", Bạn phải chọn cả đối tượng polyline và text cao độ.
Bạn chép đoạn mã nhắc nhở: (prompt "\nChon doi tuong 3DPOLYLINE & TEXT cao do:")
vào trước dòng: (setq lstent (acet-ss-to-list (ssget '((0 . "TEXT,POLYLINE"))))).
Chúc Tuynh thành công.

Cám ơn Thiep.
Tuynh làm được rùi.
Ngoài lề chút nhé, cho Tuynh hỏi là Thiep làm về lĩnh vực gì vậy?
  • 0