Đế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

#141 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 21 September 2009 - 08:25 PM

Các bạn ạ. Mình có vài lời góp ý thế này. Nếu có gì không fải mong các bạn bỏ qua cho.
Topic này tương lai sẽ giống như topic Viết lisp theo yêu cầu P1. nó sẽ rất dài và rất nặng cho diễn đàn. Mặt khác, đây là topic cho mọi người có thể tìm thấy những công cụ hỗ trợ tốt hơn cho công việc nên hằng ngày số người truy cập vào tương đối lớn. Vẫn biết diễn đàn có chức năng tìm kiếm, nhưng không phải lúc nào chúng ta cũng dễ dàng tìm thấy thứ mình muốn bằng cách này. Nếu đã một lần tìm lisp trong topic Viết lisp theo yêu cầu P1 bạn sẽ hiểu được sự khó khăn và mệt mỏi vì những bài viết kiểu như trên.
Vì vậy, nếu các bạn không fiền, xin hạn chế đến mức tối đa có thể việc post những bài viết vô bổ vào topic này. OK chứ?
@Trang: hi vọng bạn hiểu.
  • 2

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#142 kamezoko

kamezoko

    biết vẽ line

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

Đã gửi 21 September 2009 - 10:19 PM

đây là lisp cùa anh TUE NV :
;; free lisp from cadviet.com
(defun c:nt(/ lis a ss i ent chu p x)
(setvar "cmdecho" 0)
(prompt "Chon Text :")
(setq ss (ssget '((0 . "TEXT"))) i 0 lis nil res " " lisch "")
(while (< i (sslength ss))
(setq ent (entget(ssname ss i)))
(setq chu (cdr(assoc 1 ent)))
(setq p (cdr(assoc 10 ent)))
(setq lis (append lis (list (cons chu p))))
(setq lisch (strcat lisch chu res))
(setq i (1+ i))
)

(command "line")
(foreach x lis
(initget 1 (eval lisch))
(command
(if (setq a (assoc (getkword "\n Nhap chu : ") lis))
(progn
(cdr a)
)
)
)
)

(princ)
)
lisp chạy tốt nhưng nó ko nhớ điểm đã chọn(khi đánh lệnh thì phải chọn lại đối tượng)mong anh TUE sửa lại 1 chút cho nó hoàn chỉnh.,,cám ơn
  • -1

#143 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 22 September 2009 - 01:02 AM

Gửi bạn Lisp thêm các đỉnh tại các vị trí giao nhau giữa đuờng LWPOLYLINE với tất cả các đối tuợng khác cắt qua nó (bao gồm : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE).
Do không có thời gian test nhiều, nhờ các bạn kiểm tra dùm.

(defun c:AddVtx (/ doc vl ov ss)
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark doc)
(setq vl '("CMDECHO" "OSMODE" "ORTHOMODE") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 0)) ; Turn off CMDECHO, OSMODE, ORTHOMODE
(prompt "\nChon Polyline them Vertex : ")
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(foreach pt (get_interpts_with_touching ent)
(AddVtx ent pt) ) ) )
(mapcar 'setvar vl ov) ; reset Sys Vars
(vla-EndUndoMark doc)
(princ)
)

(defun AddVtx (entPL pt / obj pObj pa a1 a2 p1 p2 ce bu)
;; Transform any angle (in radians) into its equivalent between 0 and 2*pi
(defun ang<2pi (ang)
(if (and (<= 0 ang) (< ang (* 2 pi)))
ang
(ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
)
)
; get center
(defun get_center (ent param / ang1 ang2 pt1 pt2)
(setq ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.1 param)))
ang2 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.9 param)))
)
(if (or (/= ang1 ang2)
(/= ang1 (angle '(0 0 0) (vlax-curve-getFirstDeriv ent (+ 0.5 param))))
)
(progn
(setq pt1 (vlax-curve-getPointAtParam ent (+ 0.1 param))
pt2 (vlax-curve-getPointAtParam ent (+ 0.9 param)))
(inters pt1 (polar pt1 (- ang1 (/ pi 2)) 1.0) pt2 (polar pt2 (- ang2 (/ pi 2)) 1.0) nil)
)
)
)
;--- AddVtx --------
(setq obj (vlax-ename->vla-object entPL)
pObj t);PointAtObj
(or
(setq pa (vlax-curve-getParamAtPoint obj pt))
(setq pa (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj pt) )
pObj nil)
)
(if (> (- pa (setq pa (fix pa))) 0.001); bo qua t/hop diem Pt trung voi dinh cua PLINE
(progn
(if (and (setq ce (get_center obj pa)) pObj)
(progn
(setq p1 (vlax-curve-getPointAtParam obj pa)
p2 (vlax-curve-getPointAtParam obj (1+ pa)) )
(if (< pi (ang<2pi (- (angle pt p2) (angle p1 pt)))(* 2 pi))
(setq a1 (- (ang<2pi (- (angle ce p1) (angle ce pt))))
a2 (- (ang<2pi (- (angle ce pt) (angle ce p2)))) )
(setq a1 (ang<2pi (- (angle ce pt) (angle ce p1)))
a2 (ang<2pi (- (angle ce p2) (angle ce pt))) )
)
(setq bu (list (cons pa (/ (sin (/ a1 4.0)) (cos (/ a1 4.0)))) ;gia tri Bulge tai dinh truoc v/tri chen
(cons (1+ pa) (/ (sin (/ a2 4.0)) (cos (/ a2 4.0)))) ;gia tri Bulge tai dinh moi chen
))
)
(setq bu nil)
)
(vlax-invoke obj 'AddVertex (1+ pa) (list (car pt) (cadr pt)));them dinh
(setq bu (mapcar '(lambda (x) (vla-setBulge obj (car x) (cdr x))) bu));cap nhat Bulge
)
)
)

(defun get_interpts_with_touching (ent / obj bl tr ss lst intpts)
;; return a list of lists grouped by 3 from a flat list
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new)
)
;------------ ss_interpts
(setq obj (vlax-ename->vla-object ent))
(vla-getBoundingBox obj 'bl 'tr)
(and
(setq bl (vlax-safearray->list bl)
tr (vlax-safearray->list tr))
(setq ss (ssget "_c" bl tr (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE")
(cons 410 (getvar "ctab"))))
)
(setq lst_pt nil
lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(foreach intoObj lst
(if (setq intpts (vlax-invoke Obj 'IntersectWith intoObj acExtendNone))
(setq lst_pt (append (list->3pair intpts) lst_pt)) ))
)
lst_pt
)

Xin lỗi diễn đàn cho mình đính chính lại một chút nhé, lisp bác Gia Bach viết lại cho em chạy tốt trên cad 2006 mình chưa thử với cad đời cao hơn, buổi chiều khi ở cơ quan em chạy trên cad2002 lisp không cho kết quả, em chưa kiểm tra hết mà đã vội kết luận xin lỗi bác Gia Bach nhé. Cảm ơn bác Gia Bach, bác Tue, đã hoàn thành lisp này cho em. :cheers: :cheers:
  • 0

#144 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 22 September 2009 - 07:44 AM

Đây là lisp vẽ nhà dùng để vẽ bình đồ theo cách vẽ của lệnh NHA trong NOVA nhưng đã được đơn giản hóa.
- khi vẽ chỉ cân pick vào 3 điểm góc của nhà.
- Lisp vẽ được 2 loại nhà: nhà ngói (hay nhà lá) và nhà tầng với số tầng nhập vào khi vẽ.
- Với nhà ngói, các đường thể hiện mái ngói được vẽ riêng bằng một layer khác.
- toàn bộ nhà được vẽ bằng layer NHATOANDAC
Hình đã gửi


(Defun c:nha ( )
(if (not h) (setq h 1))
(setq h1 (getreal (strcat "\nCao text <"(rtos h 2 2)">:")))
(if h1 (setq h h1))
(setq laylast (getvar "clayer"))
(setq oslast (getvar "osmode"))
(setq colast (getvar "cecolor"))
(command "osmode" 109)
(setq pta (getpoint (strcat "\n pick diem thu nhat")))
(setq i1 0 i2 0)

(while (/= pta nil)
(command "undo" "begin")
(command "color" 1 "circle" pta 1)
(setq ss1 (ssget "L") ss (ssadd) ss (ssadd (ssname ss1 0) ss))
(setvar "cecolor" colast)
(setq ptb (getpoint (strcat "\n pick diem thu 2") pta))
(command "color" 2 "circle" ptb 1)
(setq ss2 (ssget "L") ss (ssadd (ssname ss2 0) ss))
(setvar "cecolor" colast)
(setq ptc (getpoint (strcat "\n pick diem thu 3") ptb))
(command "color" 3 "circle" ptc 1)
(setq ss3 (ssget "L") ss (ssadd (ssname ss3 0) ss))
(setvar "cecolor" colast)
(setq L1 (distance pta ptb) L2 (distance ptb ptc))
(setq ptd (polar pta (angle ptb ptc) L2))
(if (> L2 L1)
(setq pt1 pta pt2 ptb pt3 ptc)
(setq pt1 ptd pt2 pta pt3 ptb))
(setq L1 (distance pt1 pt2) L2 (distance pt2 pt3))
(setq goc1 (angle pt1 pt2))
(setq goc2 (angle pt2 pt3))
(setq pt4 (polar pt1 goc2 L2))
(setq pt5 (polar pt1 (- goc1 (/ pi 6)) (/ L1 2 (cos (/ pi 6)))))
(setq pt6 (polar pt3 (+ goc2 (/ pi 3)) (/ L1 -2 (cos (/ pi 6)))))
(setq pt7 (polar pt5 goc2 (/ (distance pt5 pt6) 2)))

(setq nha (cond (nha) ("Ngoi")))
(initget "Ngoi Tang")
(setq Tmp1 (strcat "\nNha mai ngoi hay nha tang [Ngoi/Tang] <" nha ">: ")
nha (cond ((getkword Tmp1)) (nha)))
(if (not (tblsearch "layer" "NHATOANDAC"))
(command "-layer" "N" "NHATOANDAC" "S" "NHATOANDAC" "color" 7 "" "")
(command "Clayer" "NHATOANDAC"))

(if (eq Nha "Ngoi")
(progn
(Command "color" bylayer "osmode" 0 "pline" pt1 pt2 pt3 pt4 pt1 "")
(if (not (tblsearch "layer" "layer1"))
(command "-layer" "N" "layer1" "S" "layer1" "color" 8 "" "")
(command "Clayer" "layer1"));if
(command "pline" pt1 pt5 pt2 "")
(command "pline" pt5 pt6 "")
(command "pline" pt3 pt6 pt4 "")
(command "osmode" 109)
(setq i1 (1+ i1))
(setvar "cecolor" colast)
(command "erase" ss "")
(command "undo" "end")
);progn
(progn
(setq tang (cond (tang) ("2tang")))
(initget "2tang 3tang 4tang 5tang 6tang")
(setq Tmp1 (strcat "\nNha bao nhieu tang [2Tang/3Tang/4Tang/5Tang/6Tang]<" tang ">: ")
tang (cond ((getkword Tmp1)) (tang)))
(Command "color" bylayer "osmode" 0 "pline" pt1 pt2 pt3 pt4 pt1"")
(if (eq tang "2tang") (command "color" 3 "text" "m" pt7 h 0 "2T"))
(if (eq tang "3tang") (command "color" 3 "text" "m" pt7 h 0 "3T"))
(if (eq tang "4tang") (command "color" 3 "text" "m" pt7 h 0 "4T"))
(if (eq tang "5tang") (command "color" 3 "text" "m" pt7 h 0 "5T"))
(if (eq tang "6tang") (command "color" 3 "text" "m" pt7 h 0 "6T"))
(setq i2 (1+ i2))
(command "osmode" 109)
(setvar "cecolor" colast)
(command "erase" ss "")
(command "undo" "end")
);progn
);if
(setq pta (getpoint (strcat "\n pick diem thu nhat")))
);while
(setvar "cecolor" colast)
(setvar "osmode" oslast)
(setvar "clayer" laylast)
(command "undo" "end")
(prompt (strcat "\nDa ve " (rtos i1 2 0) " nha ngoi va " (rtos i2 2 0) " nha tang\n"))
(prompt "\nby Thaistreetz - huuthais@yahoo.com\n")
);end.

Chú ý: Khi pick các điểm góc nhà ngói bạn bắt buộc phải pick lần lượt 3 góc theo chiều quay kim đồng hồ. Mình phát hiện lỗi này sau khi đã viết xong lisp nên ngại viết lại. bạn sử dụng chú ý một chút là ok thôi.

Nhờ Anh viết hộ cho em Lisp thêm các mẩu nhà sau
http://www.cadviet.c...s/2/mau_nha.rar
Rất cám ơn.
  • 0

#145 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 22 September 2009 - 07:45 AM

Về giá trị bulge
The bulge is the tangent of 1/4 of the included angle for the arc between the selected vertex and the next vertex in the polyline's vertex list.
A negative bulge value indicates that the arc goes clockwise from the selected vertex to the next vertex.
A bulge of 0 indicates a straight segment, and a bulge of 1 is a semicircle.

giá trị bulge tang của 1/4 góc chắn phần tử (segment).
- Nếu bulge >0 : cung tròn theo ngược chiều kim đồng hồ, ngược lại cùng chiều kim đồng hồ.
- Nếu bulge = 0 : phần tử là đuờng thẳng
- Nếu bulge = 1 : phần tử là đuờng tròn

Gửi bạn Lisp thêm các đỉnh tại các vị trí giao nhau giữa đuờng LWPOLYLINE với tất cả các đối tuợng khác cắt qua nó (bao gồm : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE).
Do không có thời gian test nhiều, nhờ các bạn kiểm tra dùm.

Chào anh gia_bach
Anh có thể giải thích rõ hơn cho Tue_NV biết giá trị bulge được không?
giá trị bulge tang của 1/4 góc chắn phần tử (segment).
Chổ này thì Tue_NV chưa hiểu lắm. Cảm ơn anh

@kamezoko : Ở dòng Select object : Bạn nhấn P (Previous) thì Lisp sẽ chọn lại đối tượng trước đó
Select object : P
:cheers:
  • 1

#146 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 22 September 2009 - 08:15 AM

.....
Anh có thể giải thích rõ hơn cho Tue_NV biết giá trị bulge được không?
giá trị bulge tang của 1/4 góc chắn phần tử (segment).

Chào Tue_NV
Bạn xem hình nhé.
Bulge = tg (α/4) = sin (α/4) / cos (α/4)
Phụ thuộc huớng của Pline, giá trị Bulge sẽ nhận giá trị âm hoặc duơng.
Hình đã gửi
  • 1

#147 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 22 September 2009 - 08:50 AM

Chào Tue_NV
Bạn xem hình nhé.
Bulge = tg (α/4) = sin (α/4) / cos (α/4)
Phụ thuộc huớng của Pline, giá trị Bulge sẽ nhận giá trị âm hoặc duơng.
Hình đã gửi

nó cũng chính là S/C trong hình vẽ này
Hình đã gửi

Bulge = s/c=tanε
ε+T=90độ
θ/2+2T= 180độ =>θ/4+T=90độ
=>ε=θ/4=>s/c=tanθ/4

Đấy là lý do vì sao Bulge = tg (α/4) như công thức của bác gia_bach
  • 4

#148 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 22 September 2009 - 03:02 PM

Minh có một bản vẽ lớn, muốn trích một phần của khu đó ra và save ra bản vẽ mới với tên khác.
Nhờ các anh giúp cho lisp chọn khu vực cần trích ( góc trên bên trái đến góc dưới bên phải ). Líp sẻ chọn tất cả đồi tượng trên, save qua bản vẽ mới, yêu cầu đặt tên file mới và khu vực trích đó được cắt theo hình chử nhật vừa chọn.
Rất mong được giúp đở,
  • 0

#149 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 22 September 2009 - 04:23 PM

Minh có một bản vẽ lớn, muốn trích một phần của khu đó ra và save ra bản vẽ mới với tên khác.
Nhờ các anh giúp cho lisp chọn khu vực cần trích ( góc trên bên trái đến góc dưới bên phải ). Líp sẻ chọn tất cả đồi tượng trên, save qua bản vẽ mới, yêu cầu đặt tên file mới và khu vực trích đó được cắt theo hình chử nhật vừa chọn.
Rất mong được giúp đở,

Lệnh Wblock làm được yêu cầu của bạn
  • 0

#150 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 22 September 2009 - 07:03 PM

Nhờ Anh viết hộ cho em Lisp thêm các mẩu nhà sau
http://www.cadviet.c...s/2/mau_nha.rar
Rất cám ơn.

Chào bạn khaosat2009
Yêu cầu của bạn có thể nói là tương đương phần mềm vẽ. thực tế bản vẽ của bạn có lẽ cũng đã được bạn vẽ bằng một phần mềm nào đó. Việc này mình có thể làm được nhưng sẽ tốn rất nhiều thời gian của mình. vì thế mình không thể hứa giúp bạn ngay được, bạn có thể nhờ thêm nhiều cao thủ khác trên diễn đàn.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#151 kamezoko

kamezoko

    biết vẽ line

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

Đã gửi 23 September 2009 - 12:13 AM

@kamezoko : Ở dòng Select object : Bạn nhấn P (Previous) thì Lisp sẽ chọn lại đối tượng trước đó
Select object : P
:cheers:

cám ơn anh TUE_NV nhiều lắm... :cheers:
  • -1

#152 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 23 September 2009 - 06:16 AM

Cám ơn Tuệ nhé lisp bạn chỉnh cho mình chạy ok thực sự cảm ơn sự nhiệt tình của Tuệ và các thành viên trong diễn đàn đã giúp đỡ mình lisp đó của bạn chạy đúng như ý tớ. Nhưng khi mình làm thì nảy sinh một vấn đề là khi mình chỉnh lại cao độ đường 3d polyline thì phải chạy lại lisp ý mình muốn thế này khi chỉnh lại cao độ đường 3d polyline thì chỉ cần chỉnh ở dạng text là cao độ đường 3d polyline cũng thay đổi theo không cần vào PROPERTIES hay chạy lại lisp nữa, mình muốn hiện cao độ ở dạng text có ý là như vậy. Nhưng thực sự lisp của bạn đã giúp tớ rất nhiều. Cám ơn bạn nhé :cheers:

Chào Tuynh
Lisp này Tue_NV dựa trên nền mà Lisp bạn Thiep viết mà hoàn thành lại theo ý của bạn
Ban đầu Bạn dùng Lisp của Tue_NV để làm. Các cao độ 3dPLINE sẽ dàn trên các Vertex của 3dPline.
Sau này muốn hiệu chỉnh thì dùng Lisp này
Khi chạy Lisp hỏi :
Pick a point on Polyine: -> Bạn Pick vào điểm cần thay đổi độ cao
Pick chon chu thay doi do cao : -> Pick chọn chữ ngay tại điểm cần thay đổi độ cao

-> Lisp sẽ hiệu chỉnh độ cao theo ý của bạn . Chúc vui vẻ
 
;; free lisp from cadviet.com
;;; Lisp thay doi do cao cac node cua POLYLINE
;;; copyright by Thiep 7/2009
;;; yeu cau: cai dat day du Expresstools
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;---------------------
(defun SAVE_MODE ()
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "cmdecho" 0)
(setvar "plinegen" 1)

)
(defun RESTORE ()
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "CECOLOR" OLD_CECOLOR)
(setvar "cmdecho" 1)
)
;;;--------------------------
;;;----------------------------------------
(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)
)
;;;-----------------------------------
(vl-load-com)
(defun c:3dp (/ ActDoc *Model* wp lwp Obj n pn pcl Pe lstP Elev lt lstN te ptc ptm)
(SAVE_MODE)
(setvar "osmode" 1)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(while (setq pn (getpoint "\nPick a point on Polyine: "))
(setq lwp (ssname (ssget pn) 0))
(redraw lwp 3)

(setq te (car(entsel "\n Pick chon chu thay doi do cao :")))

(command "ddedit" te "")
(setq ptc (cdr(assoc 10 (entget te))))

(setq heinode (atof(cdr(assoc 1 (entget te)))))
(setq ptm (list (car ptc) (cadr ptc) heinode))
(setvar "osmode" 0)
(command "move" te "" ptc ptm)
(setvar "osmode" 1)
;(setq heinode (getreal "\nEnter height of node: ")
(setq obj (vlax-ename->vla-object lwp)
lstP (ACET-GEOM-VERTEX-LIST lwp)
)
(if (eq (dxf 0 lwp) "LWPOLYLINE")
(progn
(setq Elev (vla-get-Elevation obj))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
(setq lt (list (car lt) (cadr lt) Elev))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
(progn
(setq lstP (ACET-GEOM-VERTEX-LIST lwp))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
)
)
(RESTORE)
(princ "\nChuc cac ban vui ve! Thiep")
(princ)
)

@thiep : Mạn phép bạn nhé :cheers:
  • 1

#153 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 23 September 2009 - 06:54 AM

Chào bạn khaosat2009
Yêu cầu của bạn có thể nói là tương đương phần mềm vẽ. thực tế bản vẽ của bạn có lẽ cũng đã được bạn vẽ bằng một phần mềm nào đó. Việc này mình có thể làm được nhưng sẽ tốn rất nhiều thời gian của mình. vì thế mình không thể hứa giúp bạn ngay được, bạn có thể nhờ thêm nhiều cao thủ khác trên diễn đàn.

Cám ơn Bạn.
Rất mong được Bạn và các anh giúp đỡ.
Mong tin
  • 0

#154 trieubb

trieubb

    biết vẽ ellipse

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

Đã gửi 23 September 2009 - 09:19 AM

Đây là phần tiếp theo của topic Viết lisp theo yêu cầu, mời các bạn tiếp tục thảo luận.



Xin bác Nguyen Hoanh và các cao thủ giúp em viết cái LISP thực hiện công việc sau:
http://www.cadviet.c...pfiles/2/cn.dwg
  • 0

#155 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 23 September 2009 - 09:21 AM

Minh có một bản vẽ lớn, muốn trích một phần của khu đó ra và save ra bản vẽ mới với tên khác.
Nhờ các anh giúp cho lisp chọn khu vực cần trích ( góc trên bên trái đến góc dưới bên phải ). Líp sẻ chọn tất cả đồi tượng trên, save qua bản vẽ mới, yêu cầu đặt tên file mới và khu vực trích đó được cắt theo hình chử nhật vừa chọn.
Rất mong được giúp đở,

Hề hề,
Chả biết bác Khaosat2009 có quên không chứ theo mình trong lúc chờ cái lisp hay cái gì đo hiện đại hơn, bác thử xài copyclip và pasteclip là Ok mà. Cũng chả chậm lắm đâu vì dùng kiểu gì bác cũng phải nhập mấy cái nội dung phụ bằng tay mà. Hề hề.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#156 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 23 September 2009 - 10:58 AM

Hề hề,
Chả biết bác Khaosat2009 có quên không chứ theo mình trong lúc chờ cái lisp hay cái gì đo hiện đại hơn, bác thử xài copyclip và pasteclip là Ok mà. Cũng chả chậm lắm đâu vì dùng kiểu gì bác cũng phải nhập mấy cái nội dung phụ bằng tay mà. Hề hề.

Mình không hiểu lệnh này lắm, mong được anh chỉ giúp
  • 0

#157 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 23 September 2009 - 12:51 PM

Chào Tuynh
Lisp này Tue_NV dựa trên nền mà Lisp bạn Thiep viết mà hoàn thành lại theo ý của bạn
Ban đầu Bạn dùng Lisp của Tue_NV để làm. Các cao độ 3dPLINE sẽ dàn trên các Vertex của 3dPline.
Sau này muốn hiệu chỉnh thì dùng Lisp này
Khi chạy Lisp hỏi :
Pick a point on Polyine: -> Bạn Pick vào điểm cần thay đổi độ cao
Pick chon chu thay doi do cao : -> Pick chọn chữ ngay tại điểm cần thay đổi độ cao

-> Lisp sẽ hiệu chỉnh độ cao theo ý của bạn . Chúc vui vẻ

OK bác Tuệ ạ, thanks bác nhé. Rất khâm phục bác
Chúc Tuệ sức khỏe, thành công.
  • -1

#158 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 23 September 2009 - 01:25 PM

Mình không hiểu lệnh này lắm, mong được anh chỉ giúp

Có nghĩa là bạn copy những gì bạn cần sang một bản vẽ mới và lưu bản vẽ này với một tên mới. Ý của anh Thanh Bình là vậy. Chỉ thêm một vài cái click chuột so với yêu cầu trên của bạn :cheers:
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#159 khaosat2009

khaosat2009

    biết lệnh offset

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

Đã gửi 24 September 2009 - 06:29 AM

Có nghĩa là bạn copy những gì bạn cần sang một bản vẽ mới và lưu bản vẽ này với một tên mới. Ý của anh Thanh Bình là vậy. Chỉ thêm một vài cái click chuột so với yêu cầu trên của bạn :cheers:

Đúng rồi đó bạn Thaistreetz, nhưng save bản vẻ khác ,tọa độ các đối tượng đó không thay đổi nha....!!
  • 0

#160 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 24 September 2009 - 06:49 AM

Hình đã gửi Thật khó tin bạn là dân khảo sát đấy.
Paste to original coordnates bạn không biết ah? :cheers:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD