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

#1061 thiep

thiep

    biết dimbaseline

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

Đã gửi 14 April 2010 - 03:34 PM

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?

Chào Tuynh, Nếu bạn để các đối tượng text cao độ vào 1 lớp tên là TEXTCAODO, thì lisp sau đây chỉ cần chọn POLYLINE cần update thôi:
;; free lisp from cadviet.com
;;; Lisp update do cao cho các nút cua 3DOPLY
;;; BY Thiep 03/2010
;;; Yeu cau: cai 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")
(prompt "\nChon doi tuong 3DPOLYLINE & TEXT cao do:")
(setq lstenttext (acet-ss-to-list
(ssget "X" '((0 . "TEXT") (8 . "TEXTDOCAO")))
)
entPL (ssname (ssget '((0 . "POLYLINE"))) 0)
)
(setvar "clayer" (dxf 8 entPL))
(foreach ent lstenttext
(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 lstenttext
(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)
)


Ngoài lề: Thiep không phải là dân xây dựng, dân cơ khí, hay dân trắc đạc... Thiep chỉ là "lều địa chất" Thiep yêu AutoCad, nhưng rất ít khi dùng Autocad để kiếm tiền. Vậy đó! hề! hề! hề!
  • 1

#1062 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 14 April 2010 - 04:03 PM

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

Cách này mình cũng đã từng làm lâu lắm rồi, tuy nhiên đây cũng chỉ là giải pháp tình thế thôi, vì muốn chọn được, đối tượng nằm trên p1, p2 phải có trên màn hình. Có lẽ bạn phải zoom all và bật các layer cần thiết trước khi dùng lệnh
  • 0

#1063 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 15 April 2010 - 09:41 AM

Chào Tuynh, Nếu bạn để các đối tượng text cao độ vào 1 lớp tên là TEXTCAODO, thì lisp sau đây chỉ cần chọn POLYLINE cần update thôi:

;; free lisp from cadviet.com
;;; Lisp update do cao cho các nút cua 3DOPLY
;;; BY Thiep 03/2010
;;; Yeu cau: cai 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")
(prompt "\nChon doi tuong 3DPOLYLINE & TEXT cao do:")
(setq lstenttext (acet-ss-to-list
(ssget "X" '((0 . "TEXT") (8 . "TEXTDOCAO")))
)
entPL (ssname (ssget '((0 . "POLYLINE"))) 0)
)
(setvar "clayer" (dxf 8 entPL))
(foreach ent lstenttext
(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 lstenttext
(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)
)


Ngoài lề: Thiep không phải là dân xây dựng, dân cơ khí, hay dân trắc đạc... Thiep chỉ là "lều địa chất" Thiep yêu AutoCad, nhưng rất ít khi dùng Autocad để kiếm tiền. Vậy đó! hề! hề! hề!

Cám ơn Thiep. Lisp này gần như đã hoàn thiện rùi nhỉ.
Chúc Thiep sức khoẻ, hạnh phúc, thành đạt!
Mà đặt là lớp TEXTDOCAO như trong lisp chứ Thiep.
  • 0

#1064 thiep

thiep

    biết dimbaseline

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

Đã gửi 15 April 2010 - 10:31 AM

Cám ơn Thiep. Lisp này gần như đã hoàn thiện rùi nhỉ.
Chúc Thiep sức khoẻ, hạnh phúc, thành đạt!
Mà đặt là lớp TEXTDOCAO như trong lisp chứ Thiep.

À, phải đặt lớp là TEXTDOCAO như trong lisp. Sorry
  • 0

#1065 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 15 April 2010 - 11:01 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.

Vì số nguyên có phạm vi -2147483648 => 2147483647
nếu ngoài phạm vi trên, phải dùng số thực.
Bạn thêm 1 dấu chấm vào số đầu tiên là được
1000000.*2000000+3000000/4000000-5000000
  • 1

#1066 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 16 April 2010 - 02:07 PM

Vì số nguyên có phạm vi -2147483648 => 2147483647
nếu ngoài phạm vi trên, phải dùng số thực.
Bạn thêm 1 dấu chấm vào số đầu tiên là được
1000000.*2000000+3000000/4000000-5000000

Ý mình là dùng mã lsp kia, đó là ví dụ đơn giản thôi, nếu chẳng hạn là:
100000000000*200000000000+300000000000/400000000000-500000000000
hay nhiều hàm khác phức tạp hơn thì phải chuyển tất cả các số sang số thực và ghép chúng lại theo thứ tự nhưng mình không viết mã được. Mong mọi ngườt trợ giúp, hàm có các toán tử + - * / ^ ( ). Mong giúp đỡ. Thanks
  • 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.......

#1067 truongthanh

truongthanh

    biết lệnh text

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

Đã gửi 18 April 2010 - 11:41 AM

Lỗi do CODE quá dài ?!

Huớng dẫn sử dụng : http://www.cadviet.c...o...ost&p=81489

em đã làm như bác hướng dẫn rồi mà vẫn báo lỗi như vậy khi sử dụng lisp TRIMBLK!nhờ bác giúp dùm em!
  • 0

#1068 thonghoang1

thonghoang1

    biết vẽ polygon

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

Đã gửi 18 April 2010 - 08:23 PM

mình có một đề bài nhỏ thế này mong may anh xem và giúp cho mình một lisp:mính có 2 đường bất ký giống hình vẽ,mình cần tạo ra một số đường thẳng nằm ở trong 2 đường thẳng đấy và cách đều 2 đường thẳng đó,số đường thẳng tạo ra giửa 2 đường thẳng đó tuỷ mình đưa vào.Nếu 1 đường thẳng thì nó cách đều 2 đường thẳng gốc,nếu 2 thì 4 đường thẳng đó có khoảng cách đều nhau.......Mong mấy anh giúp,
  • 0

#1069 thonghoang1

thonghoang1

    biết vẽ polygon

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

Đã gửi 18 April 2010 - 08:26 PM

xin lổi mình quên up file http://www.cadviet.c...drawing1_28.dwg
  • 0

#1070 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 19 April 2010 - 04:06 PM

em đã làm như bác hướng dẫn rồi mà vẫn báo lỗi như vậy khi sử dụng lisp TRIMBLK!nhờ bác giúp dùm em!

Nó báo lỗi gì bạn ơi ?

Tui đã check : Lisp chạy tốt. http://www.cadviet.c...o...ost&p=81690
Chú ý nếu Block của bạn thuộc Layer khác Layer "Hoga"
tìm và đổi dòng
(setq ss (ssget (list (cons 0 "INSERT") (cons 8 "Hoga"))))
thành tên Layer mong muốn.
(setq ss (ssget (list (cons 0 "INSERT") (cons 8 "Tên_Layer"))))
hoặc thành (setq ss (ssget (list (cons 0 "INSERT") )))
  • 1

#1071 road

road

    Chưa sử dụng CAD

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

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

Mong các bác giúp tôi: Làm sao tính được diện tích đào, đắp trên mặt cắt ngang được tự động hóa bằng autolisp hay VBA. Tôi gửi kèm theo file mặt cắt ngang:http://www.cadviet.com/upfiles/2/cat_ngang_1.rar
  • 0

#1072 hochoaivandot

hochoaivandot

    biết dimradius

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

Đã gửi 20 April 2010 - 09:41 PM

Em có 1 yêu cầu như thế này, không biết diễn đàn đã có người post yêu cầu tương tự chưa? Mong được giúp đỡ
Em có 1 đối tượng là 1 đường pline. Em muốn đo chiều dài của một đoạn bắt đầu từ 1 điểm trên poline và kết thúc tại 1 điểm khác trên poline, Rồi điền giá trị chiều dài đo được vào sau 1 text đã ghi sẵn.
Chọn đường thẳng cần đo. Vị trí bắt đầu đo. Vị trí kết thúc đo. Chon text cần thêm kết quả.
Nếu đã có đáp án hay cách làm khác không cần đến lisp, mong mọi người hướng dẫn. Em rất cảm ơn.
Em gởi file đính kèm.
http://www.cadviet.c...les/2/hoi_2.dwg
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#1073 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 21 April 2010 - 08:06 AM

Em có 1 yêu cầu như thế này, không biết diễn đàn đã có người post yêu cầu tương tự chưa? Mong được giúp đỡ
Em có 1 đối tượng là 1 đường pline. Em muốn đo chiều dài của một đoạn bắt đầu từ 1 điểm trên poline và kết thúc tại 1 điểm khác trên poline, Rồi điền giá trị chiều dài đo được vào sau 1 text đã ghi sẵn.
Chọn đường thẳng cần đo. Vị trí bắt đầu đo. Vị trí kết thúc đo. Chon text cần thêm kết quả.
Nếu đã có đáp án hay cách làm khác không cần đến lisp, mong mọi người hướng dẫn. Em rất cảm ơn.
Em gởi file đính kèm.
http://www.cadviet.c...les/2/hoi_2.dwg

Chú ý File CAD bạn Upload không chuẩn về đơn vị (Text ghi là 25 m, nhưng khi đo giá trị thực là 23.16)
Bạn chạy thử Lisp này :
(defun c:len (/ len ob obj ov p1 p2 pa1 pa2 str vl)
(defun *error* (msg)
(if ov (mapcar 'setvar vl ov))
(if ob (redraw ob 4))
(if (not(wcmatch (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
(princ (strcat "\n** Error: " msg " **")))
(princ))

(vl-load-com)
(setq vl '("CMDECHO" "orthomode")
ov (mapcar 'getvar vl))
(mapcar 'setvar vl '(0 0))
(while
(not
(and
(setq ob (car(entsel "\nChon doi tuong can do (LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE) : ")))
(if ob (wcmatch (cdr (assoc 0 (entget ob))) "*LINE,ARC,CIRCLE,ELLIPSE") ) ) )
(alert "\nDoi tuong da chon khong phu hop.
\nChap nhan cac doi tuong : LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE
\nChon lai :") )
(redraw ob 3)
(while (and
(setq p1 (getpoint "\nTu diem :"))
(setq p2 (getpoint "\nDem diem :"))
(setq obj (entsel "\nChon text de ghi ket qua :")) )
(if (and
(setq pa1 (vlax-curve-getParamAtPoint ob p1))
(setq pa2 (vlax-curve-getParamAtPoint ob p2))
(setq obj (vlax-ename->vla-object (car obj)))
(eq (vlax-get obj 'ObjectName) "AcDbText") )
(progn
(setq str (vlax-get obj 'TextString)
len (abs (- (vlax-curve-getdistatparam ob pa1)
(vlax-curve-getdistatparam ob pa2))) )
(vla-put-TextString obj (strcat str (rtos len) "m")) )
(alert "\nDiem chon khong thuoc doi tuong can do !
\nhoac Doi tuong ghi ket qua khong phai Text!
\nChon lai :" ) ) )
(redraw ob 4)
(mapcar 'setvar vl ov)
(princ)
)

  • 1

#1074 bachngoctung

bachngoctung

    biết lệnh copy

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

Đã gửi 22 April 2010 - 03:18 PM

- Mình có một vấn đề này cần các bạn giúp đỡ:(như hình vẽ)
Hình đã gửi
- Làm sao để vẽ hai tiếp tiếp của một cung tròn bất kỳ một cách nhanh và chính xác nhât.
- Quan trọng nhất là mình muốn nhờ các cao bạn viết cho cái lisp vẽ tiếp tuyến của cung tròn với cấu trúc lệnh vẽ như sau:
+ Đánh lệnh VTT , chọn cung tròn muốn vẽ tiếp tuyến , enter thì nó ra luôn hai cái tiếp tuyến kia. Nếu mà kết hợp ra được cái góc hợp bởi hai tiếp tuyến thì càng tốt( đơn vị đo góc độ, phút , giây)
- Cám ơn :undecided:
  • 0

#1075 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 April 2010 - 04:12 PM

- Mình có một vấn đề này cần các bạn giúp đỡ:(như hình vẽ)
Hình đã gửi
- Làm sao để vẽ hai tiếp tiếp của một cung tròn bất kỳ một cách nhanh và chính xác nhât.
- Quan trọng nhất là mình muốn nhờ các cao bạn viết cho cái lisp vẽ tiếp tuyến của cung tròn với cấu trúc lệnh vẽ như sau:
+ Đánh lệnh VTT , chọn cung tròn muốn vẽ tiếp tuyến , enter thì nó ra luôn hai cái tiếp tuyến kia. Nếu mà kết hợp ra được cái góc hợp bởi hai tiếp tuyến thì càng tốt( đơn vị đo góc độ, phút , giây)
- Cám ơn :undecided:

Lisp theo ý của bạn đây :
Chọn 1 loạt ARC -> Lisp sẽ vẽ tiếp tuyến như hình vẽ
(defun c:vtt(/ oldos ss i ent dd dc p1 p2 a)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setq ss (ssget '((0 . "ARC"))) i -1)
(setvar "osmode" 0)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq tam (cdr(assoc 10 (entget ent))))
(setq dd (vlax-curve-getstartpoint ent))
(setq dc (vlax-curve-getendpoint ent))
(setq p1 (polar dd (+ (/ pi 2) (angle dd tam)) 1))
(setq p2 (polar dc (+ (/ pi 2) (angle dc tam)) 1))
(setq a (inters dd p1 dc p2 nil))
(vl-cmdf "line" dd a "")
(vl-cmdf "line" dc a "")
);while
(setvar "osmode" oldos)
(princ)
)

  • 1

#1076 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 22 April 2010 - 04:21 PM

Lisp theo ý của bạn đây :
Chọn 1 loạt ARC -> Lisp sẽ vẽ tiếp tuyến như hình vẽ

(defun c:vtt(/ oldos ss i ent dd dc p1 p2 a)
(setq oldos (getvar "osmode"))
(setq ss (ssget '((0 . "ARC"))) i -1)
(setvar "osmode" 0)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq tam (cdr(assoc 10 (entget ent))))
(setq dd (vlax-curve-getstartpoint ent))
(setq dc (vlax-curve-getendpoint ent))
(setq p1 (polar dd (+ (/ pi 2) (angle dd tam)) 1))
(setq p2 (polar dc (+ (/ pi 2) (angle dc tam)) 1))
(setq a (inters dd p1 dc p2 nil))
(vl-cmdf "line" dd a "")
(vl-cmdf "line" dc a "")
);while
(setvar "osmode" oldos)
(princ)
)

Tue_NV xử lý thêm t/hợp góc của cung tròn = 180 độ.
(khi đó (inters dd p1 dc p2 nil) trả về nil -> .... 2 đuờng tiếp tuyến song song nhau.)
  • 2

#1077 HoangSon614

HoangSon614

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 254 Bài viết
Điểm đánh giá: 66 (tàm tạm)

Đã gửi 22 April 2010 - 04:24 PM

Chào Tue_NV!
Có vấn đề này nhờ bạn giúp mình
Mình có một loạt các block vật tư như: van, tê, cút... trên 1bản vẽ CAD
Mình thống kê thủ công dễ bị nhầm lẫn và thiếu vật tư nữa nên mình muốn một lisp thống kê Block cụ thể như:
có 4 cột và kẻ khung như sau:
Stt Tên vật tư Đơn vị tính Số lượng
1 van cái 01

Khi đánh lệnh, lisp tự động tìm các block hiện hành và thống kê như mẫu trên
Cảm ơn bạn nhiều.
(Mình đã tìm rất nhiều các lisp trên diễn đàn nhưng không có cái nào phù hợp cả)
  • 0
-~-~-~-~-~-~-~-~-~-~-~-~-~-~
Hôm qua là sự học hỏi nhận được sau 1 ngày
Ngày mai là sự bí ẩn mà chúng ta sẽ khám phá


------------------------------------------
http://www.tailieukythuat.com

#1078 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 April 2010 - 04:53 PM

Tue_NV xử lý thêm t/hợp góc của cung tròn = 180 độ.
(khi đó (inters dd p1 dc p2 nil) trả về nil -> .... 2 đuờng tiếp tuyến song song nhau.)

Cảm ơn anh giabach.
Mãi viết quá nên em chưa đặt điều kiện cho biến (setq a (inters dd p1 dc p2 nil)) khi góc của cung tròn = 180 độ.
Em đã sửa lại code
(defun c:vtt(/ oldos ss i ent dd dc p1 p2 a)
(setq oldos (getvar "osmode"))
(setq ss (ssget '((0 . "ARC"))) i -1)
(setvar "osmode" 0)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq tam (cdr(assoc 10 (entget ent))))
(setq dd (vlax-curve-getstartpoint ent))
(setq dc (vlax-curve-getendpoint ent))
(setq p1 (polar dd (+ (/ pi 2) (angle dd tam)) 1))
(setq p2 (polar dc (+ (/ pi 2) (angle dc tam)) 1))
(if (setq a (inters dd p1 dc p2 nil))
(progn
(vl-cmdf "line" dd a "")
(vl-cmdf "line" dc a "")
)
)
);while
(setvar "osmode" oldos)
(princ)
)
@HoangSon : yêu cầu của bạn thì phần mềm ACA (Autocad Architecture) giải quyết rất tuyệt vời -> Có khả năng thống kê như yêu cầu của bạn, có khả năng cập nhật (update) bảng thống kê khi ta thay đổi đối tượng (thêm, sửa , xoá). Mình không biết rằng Lisp có khả năng làm được điều này toàn vẹn hay không vì trình độ mình có hạn. Nhưng xem các file video mà bác trinhvqh upload và đã sơ sơ tìm hiểu đã biết rằng ACA giải quyết điều này 1 cách trọn vẹn
Bạn xem topic này nhé :
http://www.cadviet.c...o...8528&st=100

1- Bảng thống kê bản vẽ

2- Bảng tiến độ bản vẽ

3- Bảng thống kê cửa

4- Bảng thống kê tường (tường gạch và vách ngăn)

5- Bảng thống kê đèn

6- Bảng thống kê thiết bị vệ sinh

7- Bảng thống kê nhôm kính

8- Bảng thống kê vật dụng nội thất

9- Bảng thống kê vật liệu hoàn thiện sàn

10- Bảng thống kê diện tích

Theo trinhvqh thì ACA đọng lại là thống kê, liệu ACA có thể đáp ứng được những thống kê này?
...
Lấy 1 ví dụ điển hình về ốp gạch vệ sinh.

Khi ốp gạch vệ sinh sẽ có ron giữa các viên gạch. Liệu ACA có thống kê được diện tích ron để mua bột chà ron?

Nếu bạn làm chủ việc thống kê
Thì bạn sẽ làm được tất cả những gì bạn muốn!


  • 0

#1079 bachngoctung

bachngoctung

    biết lệnh copy

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

Đã gửi 22 April 2010 - 06:44 PM

].....

-Cám ơn Anh Tue_NV nhiều , giờ e có vấn đề này cần nhờ a giúp tiếp. Nhờ anh kết hợp giữa hai lisp này với nhau:
+ Lisp 1: lđây http://www.cadviet.c...__lenh_ts_1.lsp lisp này có chức năng là khi mình nhập giá trị A(góc chuyển hướng) và R(bán kính của đường cong) như hình thì nó sẽ ra được các thông số ở trong vòng tròn màu tím
+ Lisp 2 là cái lisp mà bác vừa giải quyết giúp em đó. Nó có chức năng vẽ ra tiếp tuyến , thì từ đó sẽ có được giá trị của góc A , bán kính R thì có sẵn
- Giờ e muốn nhờ bác kết hợp thánh 1 lisp có chức năng : chọn đường tròn rồi nó vẽ ra tiếp tuyến , và chọn điểm đặt vòng tròn chứa các giá trị và nó tính ra luôn, ko cần phải nhập giá trị A và R như lisp 1 nữa
-Bác xem giúp e nhé , Cám ơn bác
Hình đã gửi
-Mà bác Tue_NV này em tìm mua mãi hai cuốn hướng dân lập trình autolisp của Phạm Hữu Lộc mà ko thấy ở đâu, chỗ em chỉ có đúng quyển tập 2 , ko có tập 1 nên e không mua
  • 0

#1080 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 22 April 2010 - 09:47 PM

mình có một đề bài nhỏ thế này mong may anh xem và giúp cho mình một lisp:mính có 2 đường bất ký giống hình vẽ,mình cần tạo ra một số đường thẳng nằm ở trong 2 đường thẳng đấy và cách đều 2 đường thẳng đó,số đường thẳng tạo ra giửa 2 đường thẳng đó tuỷ mình đưa vào.Nếu 1 đường thẳng thì nó cách đều 2 đường thẳng gốc,nếu 2 thì 4 đường thẳng đó có khoảng cách đều nhau.......Mong mấy anh giúp,

thonghoang1 thử dùng lisp này xem. Lệnh là NSG

Hình đã gửi

Nội suy tuyến giữa 2 tuyến
  • 1