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

#261 michoma

michoma

    biết zoom

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

Đã gửi 11 October 2009 - 06:14 PM

ai có thể viết lisp đổi màu layer dùm mình đc ko?
Đầu tiên chọn layer muốn đổi , sau đó hiện bảng màu để mình chọn hoặc có thể đánh số màu mình cần , mình tìm trong diễn đàn mà ko thấy cái lisp này...
mình cám ơn trước nha :bigsmile:
  • 0

#262 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 11 October 2009 - 07:17 PM

Mình muốn PE các đường Spline , line & Arc nhưng không được . Lệnh PE có nối được không, nếu không nhờ các anh viết giúp lisp nối Spline với các đường khác để nó trở thành 1 đối tượng như đường Polyline?

Chỉ có thể nối Spline với Spline (bằng lệnh Join), Pline, line, arc với Pline, line, arc (bằng lệnh Pe với lựa chọn join hoặc lệnh Join) bạn ạ
  • 0

#263 ut_cung

ut_cung

    biết vẽ line

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

Đã gửi 12 October 2009 - 01:45 PM

@ut_cung : Bạn vui lòng nói rõ hơn. Càng chi tiết, càng cụ thể -> càng tốt. Nếu có thể, bạn hãy upload file dwg minh hoạ

Có nghĩa là mình muốn tìm cao độ của các điểm trên 1 polyline khi đã có cao độ hai điểm trên polyline này. và sau đó xuất ra 1 cái text luôn.
dwg: http://www.cadviet.c...files/2/thu.dwg
Thank!
  • 0

#264 thiep

thiep

    biết dimbaseline

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

Đã gửi 13 October 2009 - 01:22 PM

Nhờ các anh em giúp cho Thiep 1 đoạn mã lisp: làm sao khi pick vào 1 đa tuyến kín, thì Cad sẽ in ra màn hình đa tuyến được tạo bởi các điểm theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.
Đây là 1 hình ảnh đa tuyến được tạo bởi các điểm theo thứ tự vị trí ngược chiều kim đồng hồ:
Hình đã gửi
  • 0

#265 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 13 October 2009 - 02:09 PM

ai có thể viết lisp đổi màu layer dùm mình đc ko?
Đầu tiên chọn layer muốn đổi , sau đó hiện bảng màu để mình chọn hoặc có thể đánh số màu mình cần , mình tìm trong diễn đàn mà ko thấy cái lisp này...
mình cám ơn trước nha :bigsmile:

Sao không sử dụng lệnh của cad nhỉ?? :bigsmile:
Lệnh: LAYER
  • 0

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#266 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 13 October 2009 - 03:03 PM

Nhờ các anh em giúp cho Thiep 1 đoạn mã lisp: làm sao khi pick vào 1 đa tuyến kín, thì Cad sẽ in ra màn hình đa tuyến được tạo bởi các điểm theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.
Đây là 1 hình ảnh đa tuyến được tạo bởi các điểm theo thứ tự vị trí ngược chiều kim đồng hồ:
Hình đã gửi

Thiệp viết hơi bị khó hiểu.
có phải là : ghi Text tại đỉnh Pline theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.
;ATP -> Add Text Pline
(defun c:ATP (/ cEnt chcao cObj dc dd dg kc_txt ov param vl vt)
(vl-load-com)
(setq vl '("CMDECHO" "OSMODE" "AUPREC") ; Sys Var list
ov (mapcar 'getvar vl)) ; Get Old values
(mapcar 'setvar vl '(0 0 3)) ; Set new values
(if (and (setq cEnt (car (entsel "\nSelect Polyline: ")))
(eq "AcDbPolyline"
(vla-get-ObjectName
(setq cObj (vlax-ename->vla-object cEnt)))))
(progn
(if (not (setq chcao (getreal (strcat "\nNhap chieu cao Text <" (rtos (getvar "TEXTSIZE") 2 1) "> :")) ))
(setq chcao (getvar "TEXTSIZE") )
)
(setq param 1
dd (vlax-curve-getStartPoint cObj)
kc_txt (* 1.5 chcao))
(if (< (cadr dd)(cadr (vlax-curve-getPointAtParam cObj (1+ param))))
(setq vt (polar dd (/ pi 2) kc_txt))
(setq vt (polar dd (/ pi -2) kc_txt))
)
(Make_Text vt "K0" chcao)
(while (< param (vlax-curve-getEndParam cObj))
(setq dg (vlax-curve-getPointAtParam cObj param)
dc (vlax-curve-getPointAtParam cObj (1+ param)) )
(if (> (cadr dg)(cadr dc))
(setq vt (polar dg (/ pi 2) kc_txt))
(setq vt (polar dg (/ pi -2) kc_txt))
)
(Make_Text vt (strcat "K" (itoa param)) chcao)
(setq param (1+ param )
dd dg )
)
)
(princ "\n<< No Polyline Selected >>"))
(mapcar 'setvar vl ov) ; reset Sys Vars
(princ))

(defun Make_Text (pt val h)
(entmake (list (cons 0 "TEXT")
(cons 62 2);color
(cons 10 pt);position
(cons 40 h);height
(cons 1 val)
'(71 . 0)
'(72 . 1)
'(73 . 1)
(cons 11 pt)
)))

  • 2

#267 duy782006

duy782006

    PHẠM QUỐC DUY

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

Đã gửi 13 October 2009 - 03:23 PM

ai có thể viết lisp đổi màu layer dùm mình đc ko?
Đầu tiên chọn layer muốn đổi , sau đó hiện bảng màu để mình chọn hoặc có thể đánh số màu mình cần , mình tìm trong diễn đàn mà ko thấy cái lisp này...
mình cám ơn trước nha :bigsmile:

*Tiện ích đổi màu của layer thuộc đối tượng chọn.
-Tên lệnh: DML
-Thao tác:
+Nhập lệnh DML
+Chọn 1 đối tượng thuộc layer muốn đổi màu.
+Chọn màu muốn thay
-Layer chứa đối tượng sẽ được sửa thành màu vừa chọn.
day!!!!!
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#268 thiep

thiep

    biết dimbaseline

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

Đã gửi 13 October 2009 - 03:51 PM

Thiệp viết hơi bị khó hiểu.
có phải là : ghi Text tại đỉnh Pline theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.

Không phải là ghi text tại đỉnh đa tuyến đâu bác Gia_bach ạ, mà là làm sao xác định được đa tuyến có các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay không?
  • 0

#269 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 13 October 2009 - 04:29 PM

Không phải là ghi text tại đỉnh đa tuyến đâu bác Gia_bach ạ, mà là làm sao xác định được đa tuyến có các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay không?

Vấn đề của bạn là làm sao xác định đuợc tâm của đa tuyến (vị trí gắn kim đồng hồ ấy mà).
Sau khi có tâm, lần luợt duyệt qua các đỉnh -> tính góc của đỉnh.
phụ thuộc vào số đo các góc tăng hay giảm -> các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay thuận chiều kim đồng hồ.
  • 4

#270 thiep

thiep

    biết dimbaseline

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

Đã gửi 13 October 2009 - 04:33 PM

Vấn đề của bạn là làm sao xác định đuợc tâm của đa tuyến (vị trí gắn kim đồng hồ ấy mà).
Sau khi có tâm, lần luợt duyệt qua các đỉnh -> tính góc của đỉnh.
phụ thuộc vào số đo các góc tăng hay giảm -> các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay thuận chiều kim đồng hồ.

Thuật toán của Giabach hay lắm, Thiep sẽ làm ngay.
  • 0

#271 proconeng86

proconeng86

    biết lệnh break

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

Đã gửi 13 October 2009 - 10:16 PM

em thấy bên layout dùng cũng khá hay nhưng khi muốn khóa hay mở khóa,chọn tỉ lệ,tắt, mở ... của 1 khung nhìn cũng hơi lâu vì toàn phải ấn properties lên rồi mới chọn được. các bác viết hộ em cái lisp để mình có thể khóa, mở khóa khung nhìn hay để nhập tỉ lệ cho mối khung nhìn được không? cám ơn các bác trước nhé
  • 0

#272 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 October 2009 - 12:48 AM

Nhờ các anh em giúp cho Thiep 1 đoạn mã lisp: làm sao khi pick vào 1 đa tuyến kín, thì Cad sẽ in ra màn hình đa tuyến được tạo bởi các điểm theo thứ tự vị trí cùng chiều hay ngược chiều kim đồng hồ.
Đây là 1 hình ảnh đa tuyến được tạo bởi các điểm theo thứ tự vị trí ngược chiều kim đồng hồ:
Hình đã gửi

Bạn hãy dùng công thức tính diện tích bằng tọa độ. Nếu kq quả là dương là ngược chiều kim đồng hồ. kq âm là thuận chiều kim đồng hồ
Công thức tính diện tích bằng tọa độ viết bằng lisp hình như là vậy, bạn kiểm tra lại, mình kg nhớ rõ
(defun tinhdientich( lis / dt i)
(setq dt 0.0)
(setq i 0)
(setq lis (append lis (list (car lis))))
(repeat (- (length lis) 1)
(setq dt (+ dt (- (* (car (nth i lis)) (cadr (nth (1+ i) lis)))
(* (cadr (nth i lis)) (car (nth (1+ i) lis))))))
(setq i (1+ i))
)
(/ dt 2.0)
)
Với lis là danh sách tọa độ đỉnh đa tuyến
  • 2

#273 nataca

nataca

    biết lệnh adcenter

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

Đã gửi 14 October 2009 - 07:54 AM

Vấn đề của bạn là làm sao xác định đuợc tâm của đa tuyến (vị trí gắn kim đồng hồ ấy mà).
Sau khi có tâm, lần luợt duyệt qua các đỉnh -> tính góc của đỉnh.
phụ thuộc vào số đo các góc tăng hay giảm -> các đỉnh được tạo theo thứ tự ngược chiều kim đồng hồ hay thuận chiều kim đồng hồ.

Cái này chỉ đúng với đa giác lồi. Còn đa giác lõm thì không còn đúng nữa.
  • 0

#274 tivanteo

tivanteo

    biết vẽ circle

  • Members
  • PipPip
  • 36 Bài viết
Điểm đánh giá: 17 (tàm tạm)

Đã gửi 14 October 2009 - 08:46 AM

Thuật toán của Giabach hay lắm, Thiep sẽ làm ngay.

Thiệp thử dùng cái này
(defun c:tabcord(/ aCen cAng cCen cPl cRad cReg
fDr it lCnt lLst mSp pCen pT1
pT2 ptLst R tHt tLst vlaPl vlaTab
vLst cTxt oldCol nPl clFlg actDoc
tPt1 tPt2 cAng tiPt oSnp *error*
mType mHt oZin cAcu dHead hStr
hHt w1 w2 w3 isPer isAre pMul aMul
lWrt aVal xVal yVal)


;;; ****************************************************************
;;; *************************** ADJUSTMENT *************************
;;; ****************************************************************

(setq mType nil) ; Markups mode. T - digits, NIL - letters

(setq tHt -1.0) ; Table text size. Positive - absolute,
; negative multiplayer to TEXTSIZE variable

(setq mHt -2.0) ; Markups text size. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq cAcu 4) ; Precision of coordinates (from 0 to 8)

(setq dHead nil) ; If T delete table header, if NIL not delete

(setq hStr "Land # ") ; Standard header (if dHead not equal T)

(setq hHt -1.25) ; Header text size. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq w1 -10.0) ; 'Point' column width. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq w2 -20.0) ; 'X' and 'Y' colums width. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq w3 -12.0) ; 'Radius' column width. Positive - absolute,
; negative - multiplayer to TEXTSIZE variable

(setq isPer T) ; if T adds perimeter row

(setq isAre T) ; if T adds area row

(setq isGCen T) ; if T adds center of gravity row

(setq pMul 0.001) ; perimeter multiplayer

(setq aMul 0.000001) ; area multiplayer

;;; ****************************************************************
;;; ************************* END ADJUSTMENT ***********************
;;; ****************************************************************

(if(minusp tHt)
(setq tHt(getvar "TEXTSIZE"))
); end if

(if(minusp mHt)
(setq mHt(*(abs mHt)(getvar "TEXTSIZE")))
); end if

(if(minusp hHt)
(setq hHt(*(abs hHt)(getvar "TEXTSIZE")))
); end if

(if(minusp w1)
(setq w1(*(abs w1)(getvar "TEXTSIZE")))
); end if

(if(minusp w2)
(setq w2(*(abs w2)(getvar "TEXTSIZE")))
); end if

(if(minusp w3)
(setq w3(*(abs w3)(getvar "TEXTSIZE")))
); end if

(vl-load-com)

(defun Get_Acad_Ver(Gen_Only)
(if Gen_Only
(substr(getvar "ACADVER") 1 2)
(substr(getvar "ACADVER") 1 4)
); end if
); and of Get_Acad_Ver

(defun Extract_DXF_Values(Ent Code)
(mapcar 'cdr
(vl-remove-if-not
'(lambda(a)(=(car a)Code))
(entget Ent)))
); end of


(defun *error*(msg)
(setvar "CMDECHO" 1)
(if oSnp(setvar "OSMODE" oSnp))
(if oZin(setvar "DIMZIN" oZin))
(if mSp(vla-EndUndoMark actDoc))
(princ)
); end of *error*

(defun Alph_Num(Counter / lLst cRes)
(setq lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
"K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
"U" "V" "W" "X" "Y" "Z"))
(if(<= 1.0(setq cRes(/ Counter 26.0)))
(strcat(itoa(fix cRes))
(nth(- Counter(* 26(fix cRes)))lLst))
(nth Counter lLst)
); end if
); end of Alph_Num


(if(<= 16.1(atof(Get_Acad_Ver nil)))
(progn
(if
(and
(setq cPl(entsel "\nSelect LwPoliline > "))
(= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0)))
); end and
(progn
(princ "\nPlease Wait... \n")
(setq vlaPl(vlax-ename->vla-object(car cPl))
ptLst(mapcar 'append
(setq vLst(Extract_DXF_Values(car cPl)10))
(mapcar 'list(Extract_DXF_Values(car cPl)42)))
r 2 lCnt 0
tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
mSp(vla-get-ModelSpace actDoc)
); end setq
(setvar "CMDECHO" 0)
(setq oSnp(getvar "OSMODE"))
(setq oZin(getvar "DIMZIN"))
(setvar "DIMZIN" 0)
(vla-StartUndoMark actDoc)
(foreach vert ptLst
(setq vert(trans vert 0 1)
tLst(append tLst
(list(list r 0(if mType
(itoa(1+ lCnt))
(Alph_Num lCnt)))
(list r 1(rtos(car vert)2 cAcu))
(list r 2(rtos(cadr vert)2 cAcu))
(list r 3 ""))))
(if(and
(/= 0.0(last vert))
(setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt))
(setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt)))
); end and
(setq r(1+ r)
cRad(abs(/(distance pt1 pt2)
2(sin(/(* 4(atan(abs(last vert))))2))))
aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt))
fDr(vlax-curve-getFirstDeriv vlaPl
(vlax-curve-getParamAtPoint vlaPl aCen))
pCen(trans
(polar aCen(-(if(minusp(last vert)) pi(* 2 pi))
(atan(/(car fDr)(cadr fDr))))cRad)0 1)
tLst(append tLst(list
(list r 0 "center")
(list r 1(rtos(car pCen)2 cAcu))
(list r 2(rtos(cadr pCen)2 cAcu))
(list r 3(rtos cRad 2 cAcu))))
); end setq
); end if
(setq r(1+ r) lCnt(1+ lCnt))
); end foreach
(setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))
(+ 1(/(length tLst)4)) 4 (* 3 tHt)w2))
(foreach i tLst
(vl-catch-all-apply 'vla-SetText(cons vlaTab i))
(vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt)
(vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter)
); end foreach
(if(or isPer isAre)
(progn
(vla-InsertRows vlaTab r(* 0.05 tHt)1)
(vla-SetCellTextHeight vlaTab r 0(* 0.05 tHt))
(setq r(1+ r))
); end progn
); end if
(if isPer
(progn
(if(= :vlax-true(vla-get-Closed vlaPl))
(setq lWrt "Perimeter")
(setq lWrt "Length")
); end if
(vla-InsertRows vlaTab r tHt 1)
(vla-SetText vlaTab r 0 lWrt)
(vla-SetText vlaTab r 1
(rtos(*(vla-get-Length vlaPl)pMul)2 cAcu))
(vla-SetCellTextHeight vlaTab r 0 tHt)
(vla-SetCellTextHeight vlaTab r 1 tHt)
(setq r(1+ r))
); end progn
); end if
(if isAre
(progn
(if(= :vlax-true(vla-get-Closed vlaPl))
(setq aVal (rtos(*(vla-get-Area vlaPl)aMul)2 cAcu))
(setq aVal "Not closed contour")
); end if
(vla-InsertRows vlaTab r tHt 1)
(vla-SetText vlaTab r 0 "Area")
(vla-SetText vlaTab r 1 aVal)
(vla-SetCellTextHeight vlaTab r 0 tHt)
(vla-SetCellTextHeight vlaTab r 1 tHt)
(setq r(1+ r))
); end progn
); end if
(if(= :vlax-true(vla-get-Closed vlaPl))
(progn
(setq nPl(vla-Copy vlaPl))
(command "_.region" (entlast) "")
(setq cCen(vlax-get(setq cReg
(vlax-ename->vla-object(entlast)))'Centroid))
(vla-Delete cReg)
(setq clFlg T)
); end progn
); end if
(if isAre
(progn
(if cCen
(setq xVal(rtos(car cCen)2 cAcu)
yVal (rtos(cadr cCen)2 cAcu))
(setq xVal "-"
yVal "-")
); end if
(vla-InsertRows vlaTab r tHt 1)
(vla-SetText vlaTab r 0 "Gravity Center")
(vla-SetText vlaTab r 1 xVal)
(vla-SetText vlaTab r 2 yVal)
(vla-SetCellTextHeight vlaTab r 0 tHt)
(vla-SetCellTextHeight vlaTab r 1 tHt)
(vla-SetCellTextHeight vlaTab r 2 tHt)
(setq r(1+ r))
); end progn
); end if
(vla-put-VertCellMargin vlaTab (* 0.75 tHt))
(vla-SetColumnWidth vlaTab 0 w1)
(vla-SetColumnWidth vlaTab 3 w3)
(if(vlax-property-available-p vlaTab 'RepeatTopLabels)
(vla-put-RepeatTopLabels vlaTab :vlax-true)
); end if
(if(vlax-property-available-p vlaTab 'BreakSpacing)
(vla-put-BreakSpacing vlaTab (* 3 tHt))
); end if
(if dHead
(vla-DeleteRows vlaTab 0 1)
(progn
(vla-SetText vlaTab 0 0 hStr)
(vla-SetCellTextHeight vlaTab 0 0 hHt)
); end progn
); end if
(vla-put-Height vlaTab(* 1.75(/(length tLst)4)))
(princ "\n<<< Place Table >>> ")
(command "_.copybase" (trans '(0 0 0)0 1)(entlast) "")
(command "_.erase" (entlast) "")
(command "_.pasteclip" pause)
(setq lCnt 0)
(foreach v vLst
(if clFlg
(setq cAng(angle cCen(trans v 0 1))
iPt(polar v cAng (* 2 mHt)))
(setq tPt1(vlax-curve-GetPointAtParam vlaPl
(- lCnt 0.0000001))
tPt2(vlax-curve-GetPointAtParam vlaPl
(+ lCnt 0.0000001))
iPt(polar v(+(* pi 0.5)(if(minusp
(setq cAng(angle tPt1(if tPt2 tPt2
(polar tPt1(* 0.5 pi)0.0000001)))))
cAng(- cAng)))(* 2 mHt))
); end setq
); end if
(setvar "OSMODE" 0)
(setq cTxt(vla-AddText mSp
(if mType(itoa(1+ lCnt))(Alph_Num lCnt))
(vlax-3d-point iPt) mHt)
tiPt(vla-get-InsertionPoint cTxt)
lCnt(1+ lCnt)
); end setq
(vla-put-Alignment cTxt 10)
(vla-put-TextAlignmentPoint cTxt tiPt)
(setq oldCol(getvar "CECOLOR"))
(setvar "CECOLOR" "1")
(command "_.circle"(trans v 0 1) (/ mHt 4))
(setvar "CECOLOR" oldCol)
); end foreach
(setvar "DIMZIN" oZin)
(setvar "OSMODE" oSnp)
(setvar "CMDECHO" 1)
(vla-EndUndoMark actDoc)
); end progn
(princ "\n It isn't LwPolyline! Quit. ")
); end if
); end progn
(princ "\n This program works in AutoCAD 2005+ only! " )
);end if
(gc)
(princ)
); end of c:tabcord

(princ "\n http:\\\\www.AsmiTools.com ")
(princ "\n Type TABCORD to fill table of LwPolyline coordinates ")
  • 1

#275 thiep

thiep

    biết dimbaseline

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

Đã gửi 14 October 2009 - 10:04 AM

Bạn hãy dùng công thức tính diện tích bằng tọa độ. Nếu kq quả là dương là ngược chiều kim đồng hồ. kq âm là thuận chiều kim đồng hồ
Công thức tính diện tích bằng tọa độ viết bằng lisp hình như là vậy, bạn kiểm tra lại, mình kg nhớ rõ
.......

TRUNGNGAMY, cảm ơn bạn.
Thuật toán này thật tuyệt và đơn giản, Thiệp đã áp dụng thành công:
;| Lisp xac dinh Lwpolyline duoc tao co cac dinh theo thu tu
thuan chieu hay nguoc chieu kim dong ho
Yeu cau: Express tools duoc cai dat day du|;
(defun tinhdientich (lis / dt i)
(setq dt 0.0)
(setq i 0)
(setq lis (append lis (list (car lis))))
(repeat (- (length lis) 1)
(setq dt (+ dt
(- (* (car (nth i lis)) (cadr (nth (1+ i) lis)))
(* (cadr (nth i lis)) (car (nth (1+ i) lis)))
)
)
)
(setq i (1+ i))
)
(/ dt 2.0)
)
(defun c:clockwise (/ en lstp dt)
(setq en (ssname (ssget '((0 . "LWPOLYLINE"))) 0)
lstp (ACET-GEOM-VERTEX-LIST en)
)
(If (minusp (tinhdientich lstp))
(princ
"\LWP duoc tao co thu tu dinh NGUOC chieu kim dong ho"
)
(princ
"\LWP duoc tao co thu tu dinh THUAN chieu kim dong ho"
)
)
(princ)
)

Thiệp thử dùng cái này
(defun c:tabcord(/ aCen cAng cCen cPl cRad cReg
(princ "\n Type TABCORD to fill table of LwPolyline coordinates ")

tivanteo, Cảm ơn bạn.
Lisp của bạn cho thiep rất tuyệt, rất có ích cho các nhà Địa chính, trắc đạc. Nó tạo ra 1 TABLE tọa độ các góc ranh, và rất tuyệt khi đưa các tên điểm ranh ra ngoài ranh.
  • 0

#276 thiep

thiep

    biết dimbaseline

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

Đã gửi 15 October 2009 - 04:05 PM

Thiep xin hỏi tiếp: 1 cung ellipse, là 1 đối tượng ELLIPSE hở. Làm sao tạo được 1 cung ellipse này khi biết các thông số: góc cung đầu; góc cung cuối, tâm ellipse, bán kính trục lớn ( R ), tỷ số r/R.
Xin các anh em 1 đoạn mã lisp để tạo cung ellipse này.
  • 0

#277 ut_cung

ut_cung

    biết vẽ line

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

Đã gửi 17 October 2009 - 07:48 AM

Có nghĩa là mình muốn tìm cao độ của các điểm trên 1 polyline khi đã có cao độ hai điểm trên polyline này. và sau đó xuất ra 1 cái text luôn.
dwg: http://www.cadviet.c...files/2/thu.dwg
Thank!

Bác Tuệ đã hiểu ý mình chưa vậy. bác tưởng tượng mình có một polyline. Có cao độ điểm đầu và điểm cuối, Giờ mình muốn tìm cao độ của các điểm nằm trên polyline này (nằm giữa hai điểm). Sau khi tìm được cao độ mình pick một điểm cạnh đó để ghi giá trị cao độ vào đấy.
Hy vọng lần này bác hiểu ý của mình!
Chúc mọi người cuối tuần vui vẽ!
  • 0

#278 svba1608

svba1608

    Tưởng Thị Tú Khuyên

  • Moderator
  • PipPipPipPipPipPipPip
  • 601 Bài viết
Điểm đánh giá: 620 (tốt)

Đã gửi 17 October 2009 - 06:35 PM

Xin chào Diễn đàn! Hôm nay em muốn xin 2 lisp, có công dụng như sau:
1. Lisp gán giá trị của text này cho text kia, lisp này giống lệnh MA, nhưng chỉ thay đổi giá trị của text đích cho giống text nguồn mà không thay đổi các yếu tố khác như layer, màu sắc, kiểu text. Lisp này khác lisp ánh xạ giá trị text của anh gia_bach ở chỗ: chỉ cần thay đổi giá trị một lần, lần sau khi text nguồn thay đổi, text đích không cần thay đổi theo.
2. Lisp quay đối tượng: thao tác như sau:
+ Nhập lệnh.
+ Chọn tâm quay. (điểm A).
+ Chọn điểm quay. (điểm :bigsmile:.
Khi đó ta có thể quay đối tượng theo điểm quay B mà tâm là A. Đến vị trí cần thiết, enter để kết thúc lệnh.
  • 0
http://khuyen.space

#279 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 17 October 2009 - 09:09 PM

Xin chào Diễn đàn! Hôm nay em muốn xin 2 lisp, có công dụng như sau:
1. Lisp gán giá trị của text này cho text kia, lisp này giống lệnh MA, nhưng chỉ thay đổi giá trị của text đích cho giống text nguồn mà không thay đổi các yếu tố khác như layer, màu sắc, kiểu text. Lisp này khác lisp ánh xạ giá trị text của anh gia_bach ở chỗ: chỉ cần thay đổi giá trị một lần, lần sau khi text nguồn thay đổi, text đích không cần thay đổi theo.
2. Lisp quay đối tượng: thao tác như sau:
+ Nhập lệnh.
+ Chọn tâm quay. (điểm A).
+ Chọn điểm quay. (điểm B ).
Khi đó ta có thể quay đối tượng theo điểm quay B mà tâm là A. Đến vị trí cần thiết, enter để kết thúc lệnh.

1. svba có thể xem ở đây : Bài viết số 14 và bài viết số 17
2. Em có thể minh họa bằng file .dwg được không?

Bác Tuệ đã hiểu ý mình chưa vậy. bác tưởng tượng mình có một polyline. Có cao độ điểm đầu và điểm cuối, Giờ mình muốn tìm cao độ của các điểm nằm trên polyline này (nằm giữa hai điểm). Sau khi tìm được cao độ mình pick một điểm cạnh đó để ghi giá trị cao độ vào đấy.
Hy vọng lần này bác hiểu ý của mình!
Chúc mọi người cuối tuần vui vẽ!

Chào ut_cung. Bạn có thể nói rõ hơn về những con số nội suy ở giữa PLINE được tính như thế nào không? Biết được cách tính như thế nào thì khi viết Lisp mới đúng ý của bạn được
  • 1

#280 pucca

pucca

    Chưa sử dụng CAD

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

Đã gửi 18 October 2009 - 03:51 PM

Chào các bạn. Mình đang có 2 lisp: tính tổng 1 loạt text rồi ghi sang 1 text và lisp ánh xạ 1 text sang text khác để tự động cập nhật theo. Giờ mình cần 1 lisp để tính tổng 1 loạt text field và tổng tự động cập nhật theo (sau khi REGEN) sau mỗi thay đổi của 1 trong các text field. Các bạn giúp mình kết hợp 2 lisp này được không. Cảm ơn nhiều :bigsmile: .

Tính tổng:
;************************* TINH TONG ************************************
(defun C:+ (/ cmd i newe e ss sslen txt Tong)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "Undo" "BEgin")
(princ "Chu y dung lenh UN de dat so sau dau phay!")
(setq Tong 0)
(setq ss (ssget))
(setq sslen (sslength ss))
(while (> sslen 0)
(setq e (entget (ssname ss (setq sslen (1- sslen)))))
(if (or
(= (cdr (assoc 0 e)) "TEXT")
(= (cdr (assoc 0 e)) "MTEXT")
(= (cdr (assoc 0 e)) "DIMENSION")
)
(progn
(setq tong (+ tong (distof (cdr (assoc 1 e)) 2)))
(entmod e)
)
)
)
(setq newe (car (entsel "\nTong:")))
(setq newe (entget newe '("ACAD")))
(redraw (cdr (assoc -1 newe)) 4)
(if (or
(= (cdr (assoc 0 newe)) "TEXT")
(= (cdr (assoc 0 newe)) "MTEXT")
(= (cdr (assoc 0 newe)) "DIMENSION")
)
(progn
(setq txt (rtos tong 2))
(setq newe (subst (cons 1 txt) (assoc 1 newe) newe))
(entmod newe)

)
)
(redraw (cdr (assoc -1 newe)) 1)
(command "Undo" "End")
)


Ánh xạ text
(defun c:LinkT (/ ss_ent ent ss e cmd);Link Text
(if (> (atof (substr (getvar "ACADVER") 1 4)) 16.1) ;;;AutoCAD 2006 16.2
(progn
(vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(and (princ "\nChon Text goc : ")
(setq ss_ent (ssget "_:S:E" '((0 . "TEXT"))) )
(setq ent (vlax-ename->vla-object (ssname ss_ent 0)))
(princ "\nChon Text can Link gia tri tu Text goc : ")
(setq ss (ssget (list (cons 0 "TEXT")) ))
(foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
(vla-put-TextString
(vlax-ename->vla-object e)
(strcat"%<\\AcObjProp Object(%<\\_ObjId "(vl-princ-to-string (vla-get-ObjectId ent)) ">%).TextString >%")
)
)
)
(setvar "cmdecho" cmd)
(command "_.undo" "_end")(princ)
)
(alert "\nChi chay tren Autocad 2006-2010")
)
)

  • 0