thao_tedi
-
Số lượng nội dung
14 -
Đã tham gia
-
Lần ghé thăm cuối
Bài đăng được đăng bởi thao_tedi
-
-
Chào các bác.
Em thiết kế đường bằng Land desktop. Trong Land cắt ngang không thế hiện độ dốc của mặt đường và taluy nhưng hiện giờ Chủ đầu tư đang bắt thế hiện nên các chú CADer đang phải làm bằng tay. Em có một lisp thể hiện độ dốc taluy 3:1, 2:1... bằng lệnh grade nhưng nó không chạy ra độ dốc phần trăm của mặt đường. Em muốn thêm vào lisp này lệnh slope dùng cho độ dốc mặt đường khi đó mặt đường sẽ có độ dốc ví dụ 2.0%, 4.5%..v..v còn ta luy dùng lệnh grade như cũ sẽ có giá trị 3.0:1. 4.0:1...Em đã mày mò nhưng vẫn chưa ra. Mong các bác giúp em.
Xin cảm ơn nhiều.
Lisp gốc của em như sau:
(defun c:grade ()
textsize 0.5
osmode 1
(prompt "\npick points for the grade")
(setq pnt1 (getpoint) pnt2 (getpoint pnt1))
(setq ang1 (angle pnt1 pnt2))
;(setq ang1 (getangle))
(setq tanofang (/ (sin ang1) (cos ang1)))
(if (= tanofang 0) (setq grade1 0.0)
(setq grade1 (/ 1 tanofang))
)
(setq txt1 (strcat (rtos (abs grade1) 2 1) ":1"))
;(setq pnt1 (getpoint "\nPick location for text"))
(setq midpt (list (/ (+ (car pnt1) (car pnt2)) 2) (/ (+ (cadr pnt1) (cadr
pnt2)) 2)))
(setq odist (getvar "textsize"))
(setq ang2 (+ ang1 (/ pi 2)))
(setq osmd (getvar "osmode"))
(setvar "osmode" 0)
(setq inspt (polar midpt ang2 odist))
(command "text" "mc" inspt "" (rtd ang1) txt1) ; middle centre justified
(setvar "osmode" osmd)
(princ)
) ; replace the "c" above with "bc" for bottom centre
(defun rtd (a)
(/ (* a 180.0) pi)
)
(defun c:slope ()
textsize 0.5
osmode 1
(prompt "\npick points for the slope")
(setq pnt1 (getpoint) pnt2 (getpoint pnt1))
(setq ang1 (angle pnt1 pnt2))
;(setq ang1 (getangle))
(setq tanofang (/ (sin ang1) (cos ang1)))
(if (= tanofang 0) (setq slope1 0.0%)
(setq slope1 (/ (* 100 (- (cadr pnt1) (cadr pnt2)) (- (car pnt1) (car pnt2)))
))
(setq txt1 (strcat (rtos (abs slope1) 2 1) "%"))
;(setq pnt1 (getpoint "\nPick location for text"))
(setq midpt (list (/ (+ (car pnt1) (car pnt2)) 2) (/ (+ (cadr pnt1) (cadr
pnt2)) 2)))
(setq odist (getvar "textsize"))
(setq ang2 (+ ang1 (/ pi 2)))
(setq osmd (getvar "osmode"))
(setvar "osmode" 0)
(setq inspt (polar midpt ang2 odist))
(command "text" "mc" inspt "" (rtd ang1) txt1) ; middle centre justified
(setvar "osmode" osmd)
(princ)
) ; replace the "c" above with "bc" for bottom centre
(defun rtd (a)
(/ (* a 180.0) pi)
)
-
Chào cả nhà.
Em đang thiết kế đường bằng Land desktop 2005. Trong Land không thế hiện độ dốc mặt đường và taluy do đó mấy Cadder phải làm bằng tay. Em có một lisp thể hiện độ dốc taluy bằng lệnh grade cho kết quả ví dụ 3.0:1.0, 2.0/1.0.. Em muốn thêm phần cho cho độ dốc mặt đường bằng lệnh slope cho kết quả độ dốc mặt đường là 1.0%, 4.5% .v.v.
Lisp của em như sau: Em đang mày mò sửa lẹnh slope nhưng vẫn chưa được.
(defun c:grade ()
textsize 0.5
osmode 1
(prompt "\npick points for the grade")
(setq pnt1 (getpoint) pnt2 (getpoint pnt1))
(setq ang1 (angle pnt1 pnt2))
;(setq ang1 (getangle))
(setq tanofang (/ (sin ang1) (cos ang1)))
(if (= tanofang 0) (setq grade1 0.0)
(setq grade1 (/ 1 tanofang))
)
(setq txt1 (strcat (rtos (abs grade1) 2 1) ":1"))
;(setq pnt1 (getpoint "\nPick location for text"))
(setq midpt (list (/ (+ (car pnt1) (car pnt2)) 2) (/ (+ (cadr pnt1) (cadr
pnt2)) 2)))
(setq odist (getvar "textsize"))
(setq ang2 (+ ang1 (/ pi 2)))
(setq osmd (getvar "osmode"))
(setvar "osmode" 0)
(setq inspt (polar midpt ang2 odist))
(command "text" "mc" inspt "" (rtd ang1) txt1) ; middle centre justified
(setvar "osmode" osmd)
(princ)
) ; replace the "c" above with "bc" for bottom centre
(defun rtd (a)
(/ (* a 180.0) pi)
)
(defun c:slope ()
textsize 0.5
osmode 1
(prompt "\npick points for the slope")
(setq pnt1 (getpoint) pnt2 (getpoint pnt1))
(setq ang1 (angle pnt1 pnt2))
;(setq ang1 (getangle))
(setq tanofang (/ (sin ang1) (cos ang1)))
(if (= tanofang 0) (setq slope1 0.0%)
(setq grade1 (/ 1 tanofang))
)
(setq txt1 (strcat (rtos (abs grade1) 2 1) ":1"))
;(setq pnt1 (getpoint "\nPick location for text"))
(setq midpt (list (/ (+ (car pnt1) (car pnt2)) 2) (/ (+ (cadr pnt1) (cadr
pnt2)) 2)))
(setq odist (getvar "textsize"))
(setq ang2 (+ ang1 (/ pi 2)))
(setq osmd (getvar "osmode"))
(setvar "osmode" 0)
(setq inspt (polar midpt ang2 odist))
(command "text" "mc" inspt "" (rtd ang1) txt1) ; middle centre justified
(setvar "osmode" osmd)
(princ)
) ; replace the "c" above with "bc" for bottom centre
(defun rtd (a)
(/ (* a 180.0) pi)
)
Xin chân thành cảm ơn các bác!
-
Cảm ơn bạn rất nhiều. Đúng là cái mình muốn đó.
Chúc bạn luôn vui vẻ và gặp nhiều may mắn!
-
Em có một lisp dùng để tính cao độ và khoảng cách so với điểm gốc. Lisp này khi chạy thì ra text cao độ tuyệt đối và khoảng cách offset. Em muốn giữa 2 text này có thêm một đoạn thẳng ngăn cách giữa 2 text. Mong các bác sửa giùm em. Xin chân thành cảm ơn.
Mã của lisp như sau:
;*******************************************************************************
***************;
;Ghi cao do, offset cua diem can cu vao diem goc
(defun c:eff ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)
(setvar "osmode" 1)
(command "ucs" "w")
(setq pt (getpoint "\nPick reference point: ")
ent (entget(car(entsel "\nSelect elevation text: ")))
etype (cdr(assoc 0 ent))
txth (cdr(assoc 40 ent))
)
(if (/= etype "TEXT") (progn
(princ "\nThe elevation selection must be a TEXT entity")
(exit))
(setq elev (atof(cdr(assoc 1 ent))))
)
(command "layer" "m" "UNSUITABLE" "")
(while (setq p1(getpoint "\nPick offset point"))
(setq elev1 (+ elev (- (cadr p1) (cadr pt)))
offset (abs(- (car p1) (car pt)))
p01 (polar p1 (* 3.0 (/ pi 2)) txth)
p01 (polar p01 pi (* 0.9 txth))
p02 (polar p01 0 (* 1.6 txth))
ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "" (rtos elev1 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p01) (cadr p01) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(setq ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "" (rtos offset 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p02) (cadr p02) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(princ "\nPress ESC or SPACE bar to cancel")
)
(end_task)
)
-
Chào hhhhggg,
Mình có lisp này nó chạy ra khoảng cách so với điểm gốc và cao độ tuyệt đối (dựa vào điểm gốc). Tuy nhiên text xuất ra không được đẹp lắm. Lisp này thích hợp cho cả tính cao độ cống, cao độ đào đắp đất không thích hợp. Bạn nào giỏi về lisp kết hợp 2 lisp này ra kết quả là một leader hoặc một block giống của hhhhggg với Mtext có 2 dòng : 1 dòng là cao độ tuyệt đối, một dòng là khoảng cách tương đối so với điểm gốc thì tốt.
Lisp mình như sau:
;*******************************************************************************
***************;
;Ghi cao do, offset cua diem can cu vao diem goc
(defun c:eff ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)
(setvar "osmode" 1)
(command "ucs" "w")
(setq pt (getpoint "\nPick reference point: ")
ent (entget(car(entsel "\nSelect elevation text: ")))
etype (cdr(assoc 0 ent))
txth (cdr(assoc 40 ent))
)
(if (/= etype "TEXT") (progn
(princ "\nThe elevation selection must be a TEXT entity")
(exit))
(setq elev (atof(cdr(assoc 1 ent))))
)
(command "layer" "m" "UNSUITABLE" "")
(while (setq p1(getpoint "\nPick offset point"))
(setq elev1 (+ elev (- (cadr p1) (cadr pt)))
offset (abs(- (car p1) (car pt)))
p01 (polar p1 (* 3.0 (/ pi 2)) txth)
p01 (polar p01 pi (* 0.9 txth))
p02 (polar p01 0 (* 1.6 txth))
ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "Cao ®é: " (rtos elev1 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p01) (cadr p01) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(setq ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "K.c¸ch: " (rtos offset 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p02) (cadr p02) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(princ "\nPress ESC or SPACE bar to cancel")
)
(end_task)
)
Chúc các bạn vui vẻ!
của bạn đây :Cái lisp này bị vấn đề là dùng xong nó mất chế độ bắt điểm, Mình loay hoay nhưng chưa sửa được, Bác pro nào thêm dòng lệnh bật lại chế độ bắt điểm júp em luôn với !
CODE
;VE CAO TRINH
(DEFUN C:CT (/ CMD PT1 PT2 PT3 PT4 PT5 PT6 PT7 PT8 NPI TX DX DY TL OSM OLL
CRST RSIZE TSIZE STR PRMT FCH NBC OLDERR)
;(SETQ OLDERR *error*
; *error* loisb)
(command "layer" "m" "ghichu" "c" "150" """")
(setq oldos (getvar "osmode"))
;(setvar "osmode" 0)
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ NBC (GETVAR "CLAYER"))
(SETVAR "CMDECHO" 0)
(SETQ PT1 (GETPOINT "\nDiem cao trinh:"))
(SETQ TX (GETSTRING "\nCao trinh:"))
(SETQ FCH (SUBSTR TX 1 1))
(IF (= FCH "@") (SETQ TX (STRCAT "%%P" (SUBSTR TX 2 (- (STRLEN TX) 1)))))
(SETQ CRST (GETVAR "TEXTSTYLE"))
(SETQ RSIZE (CDR (ASSOC 40 (TBLSEARCH "STYLE" CRST))))
(SETQ TSIZE (GETVAR "TEXTSIZE"))
(SETQ STR (RTOS TSIZE 2))
(SETQ PRMT (STRCAT "\nText height <" STR ">:"))
(IF (= RSIZE 0)
(PROGN
(INITGET 4)
(SETQ TSIZE (GETREAL PRMT))
(IF (= TSIZE NIL) (SETQ TSIZE (GETVAR "TEXTSIZE"))
(SETVAR "TEXTSIZE" TSIZE))
)
)
(PRINC)
(SETQ TL (/ (GETVAR "TEXTSIZE") 2))
(SETVAR "OSMODE" 0)
(SETQ DX (CAAR (CDR (TEXTBOX (LIST (CONS 1 TX))))))
(SETQ NPI (/ PI 2))
(SETQ PT4 (POLAR PT1 NPI (* 1 TL)))
(SETQ PT2 (POLAR PT4 PI (* 2 TL)))
(SETQ PT3 (POLAR PT4 0 (* 2 TL)))
(SETQ PT5 (POLAR PT4 NPI (* 5 TL)))
(SETQ PT6 (POLAR PT2 NPI TL))
(SETQ PT7 (POLAR PT6 0 (+ (* 3.7 TL) DX)))
(SETQ PT8 (POLAR PT6 NPI (* 1 TL)))
(SETQ PT8 (POLAR PT8 0 (* 2.5 TL)))
(SETQ PT9 (POLAR PT1 pi (* 2 TL)))
(SETQ PT10 (POLAR PT1 0 (* 2 TL)))
(COMMAND "COLOR" "84" "")
(command "-style" "cao trinh" "jang.shx" "0" "1" "0" "n" "n" "n")
(IF (= RSIZE 0)(COMMAND "TEXT" PT8 TSIZE 0 tX) (COMMAND "TEXT" PT8 0 TX))
(COMMAND "COLOR" "7" "")
(COMMAND "SOLID" PT1 PT2 PT4 "" "" "pLINE" PT1 pt3 pt2 "")
(COMMAND "COLOR" "150" "")
(COMMAND "pLINE" PT1 PT5 "" "pLINE" PT6 PT7 "" "pLINE" pt9 pt10"")
(SETVAR "CLAYER" "0")
(command "ddedit" pause)
(COMMAND "COLOR" "BYLAYER" "")
(SETVAR "CMDECHO" CMD)
(SETVAR "CLAYER" NBC)
(setvar "osmode" 687)
(PRINC)
)
-
Cám ơn bác nhiều.
Em thành thật xin lỗi bác là do em chưa đặt biến CMDECHO = 0. Bây giờ thì nó chạy tốt rồi.
Chúc các bác luôn mạnh khoẻ và gặp nhiều may mắn!
-
Em down về và chạy lisp tgtext.lsp. Khi chạy nó báo lỗi như sau:
Command: tgtext
Chuoi muon them o giua :+
Them Text cach ki tu Dau hay Them Text cach ki tu Cuoi :c
Ban muon them chuoi nay cach vi tri cuoi bao nhieu ki tu :7
Chon chu muon chinh.; error: too many arguments
Lisp tgtext e down trên mạng như sau:
;; free lisp from cadviet.com
(defun c:tgtext()
(command "undo" "be")
(command "cmdecho" 0)
(setq gtext (getstring 5"\nChuoi muon them o giua :"))
(initget "D C")
(setq ans (getkword "\n Them Text cach ki tu Dau hay Them Text cach ki tu Cuoi :"))
(if (= ans "D")
(progn
(setq vitri (getint "\n Ban muon them chuoi nay cach vi tri dau bao nhieu ki tu :"))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget \'((0 . "TEXT,MTEXT"))) n (sslength ss) i 0)
(while (< i n)
(setq e (entget(ssname ss i)))
(setq chuoicu (cdr(assoc 1 e)))
(setq tachdau (substr chuoicu 1 vitri))
(setq tachcuoi (substr chuoicu (1+ vitri) (strlen chuoicu)))
(setq chunoi (strcat tachdau gtext tachcuoi))
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(setq i (1+ i))
)
)
)
(if (= ans "C")
(progn
(setq vitri (getint "\n Ban muon them chuoi nay cach vi tri cuoi bao nhieu ki tu :"))
(prompt "\nChon chu muon chinh.")
(setq ss (ssget \'((0 . "TEXT,MTEXT"))) n (sslength ss) i 0)
(while (< i n)
(setq e (entget(ssname ss i)))
(setq chuoicu (cdr(assoc 1 e)))
(setq tachdau (substr chuoicu 1 (- (strlen chuoicu) vitri)))
(setq tachcuoi (substr chuoicu (+ (- (strlen chuoicu) vitri) 1) vitri))
(setq chunoi (strcat tachdau gtext tachcuoi))
(setq e (subst (cons 1 chunoi) (assoc 1 e) e))
(entmod e)
(setq i (1+ i))
)
)
)
(command "undo" "end")
(princ)
)
Mong các bác kiểm tra giúp em xem bị lỗi ở đâu. E dùng Civil 3D 2008 có bản quyền.
-
Kính chào các bác.
Nhờ các bác viết giùm em một lisp chuyển số (là lý trình của trắc dọc) thành số có dấu cộng (+) phân cách đơn vị hàng nghìn. Ví dụ số 2200.000 thành số 2+200.000. Lisp này có thể chọn liền một lúc được nhiều số cùng một lúc.
Xin chân thành cảm ơn các bác trước!
-
Em có một VBA vẽ Pline. Nhưng các Pline này không nối được với nhau. Các bác giúp em sửa VBA này để khi vẽ Pline thì nó sẽ nối các Pline riêng lẻ thành 1 Pline và khi nhập C thì nó nối với điểm đầu tiên tạo thành một Pline kín (như lệnh Pline trong AutoCAd thông thường).
Xin cám ơn các bác.!
Code VBA của e như sau:
Public Sub Diem()
Dim plineObj As AcadLWPolyline
Dim StPnt As Variant
Dim EdPnt As Variant
Dim prompt1 As String
Dim prompt2 As String
Dim Point(0 To 3) As Double
prompt1 = vbCrLf & " Enter a first point:"
prompt2 = vbCrLf & " Enter a second point:"
StPnt = ThisDrawing.Utility.GetPoint(, prompt1)
EdPnt = ThisDrawing.Utility.GetPoint(StPnt, prompt2)
Point(0) = StPnt(0): Point(1) = StPnt(1)
Point(2) = EdPnt(0): Point(3) = EdPnt(1)
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Point)
StPnt = EdPnt
Retry:
On Error Resume Next
EdPnt = ThisDrawing.Utility.GetPoint(StPnt, vbCrLf & "Enter a next point: ")
If Err = 0 Then
Point(0) = StPnt(0): Point(1) = StPnt(1)
Point(2) = EdPnt(0): Point(3) = EdPnt(1)
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Point)
Else
Err.Clear
GoTo endP
End If
StPnt = EdPnt
GoTo Retry
endP:
End Sub
-
Cám ơn bác nhiều lắm. Chúc bác mạnh khoẻ và gặp nhiều may mắn!
-
Em làm một cái userform giải phương trình bậc nhất ax+b = 0. Code của user form như sau:
Public Sub OKcmd_Click()
Dim a As Double
Dim b As Double
Dim x As Double
a = CDbl(aso.Text)
b = CDbl(bso.Text)
If a = 0 Then
MsgBox "Phuong trinh vo nghiem" & vbCrLf & "De nghi nhap so vao bien a"
Else
x = (-1 * B ) / a
End If
xso.Text = x
End Sub
Private Sub Cancelcmd_Click()
Unload Me
End
End Sub
Em không biết cách khi nhập a, b là text thì sẽ xuất hiện thông báo lỗi và yêu cầu nhập lại và khi giải ra nghiệm thì sẽ không thể thay đổi giá trị ô chứa nghiệm đó (không cho phép thay đổi tetx box ghi nghiệm).
Link file dvb là: http://www.cadviet.com/upfiles/phuongtrinhbacnhat.dvb
Mong các bác giúp đỡ!
-
Em chào các bác.
Em thấy trong VBA help đây là ví dụ về vẽ line. Nhưng cái này chỉ có vẽ cho 2 điểm và dừng lại. Em không biết cách vẽ liên tiếp từ điểm thứ nhất đến điểm chọn thứ n thì sử dụng hàm for như thế nào. Các ví dụ của Autodesk thì toàn vẽ line qua 2 điểm có tọa độ cho trước (..chán). Bác nào biết làm ơn giúp em với.
Public Sub Line()
Dim lineObj As AcadLine
Dim startPoint As Variant
Dim endPoint As Variant
' Vẽ line qua 2 điểm được pick trên màn hình AutoCAD
startPoint = ThisDrawing.Utility.GetPoint(, "Enter a first point: ")
endPoint = ThisDrawing.Utility.GetPoint(, "Enter a second point: ")
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
End Sub
-
Mình có một lisp ghi khoảng cách và cao độ tuyệt đối so với khoảng cách và cao độ gốc (cái này thích hợp cho thiết kế trắc ngang, tính cao độ đào đất yếu và cao độ cống) nhưng format nó không được đẹp lắm. Các bạn có thể giúp mình sửa nó để kết quả tạo ra một leader với Mtext trong đó Mtext gồm 2 dòng: Dòng trên là khoảng cách tương đối so với điểm gốc chọn ban đầu, dòng thứ 2 là cao độ tuyệt đối của điểm được chọn được không?
Xin cảm ơn
;*******************************************************************************
***************;
;Ghi cao do, offset cua diem can cu vao diem goc
(defun c:eff ( / pt p1 p01 p02 ent ecopy elev elev1 offset etype txth)
(setvar "osmode" 1)
(command "ucs" "w")
(setq pt (getpoint "\nPick reference point: ")
ent (entget(car(entsel "\nSelect elevation text: ")))
etype (cdr(assoc 0 ent))
txth (cdr(assoc 40 ent))
)
(if (/= etype "TEXT") (progn
(princ "\nThe elevation selection must be a TEXT entity")
(exit))
(setq elev (atof(cdr(assoc 1 ent))))
)
(command "layer" "m" "UNSUITABLE" "")
(while (setq p1(getpoint "\nPick offset point"))
(setq elev1 (+ elev (- (cadr p1) (cadr pt)))
offset (abs(- (car p1) (car pt)))
p01 (polar p1 (* 3.0 (/ pi 2)) txth)
p01 (polar p01 pi (* 0.9 txth))
p02 (polar p01 0 (* 1.6 txth))
ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "Cao ®é: " (rtos elev1 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p01) (cadr p01) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(setq ecopy (list (assoc 0 ent)
(cons 100 "AcDbEntity")
(cons 8 "UNSUITABLE")
(cons 100 "AcDbText")
(assoc 10 ent)
(assoc 40 ent)
(cons 1 (strcat "K.c¸ch: " (rtos offset 2 2)))
(assoc 50 ent)
(assoc 41 ent)
(assoc 51 ent)
(assoc 7 ent)
(cons 71 0)
(cons 72 2)
(list 11 (car p02) (cadr p02) 0.0)
(list 210 0.0 0.0 1.0)
(cons 100 "AcDbText")
(cons 73 2)
)
)
(entmake ecopy)
(princ "\nPress ESC or SPACE bar to cancel")
)
(end_task)
)
Sửa lisp thể hiện độ dốc (grade và slope)
trong AutoLisp
Đã đăng · Trả lời báo cáo
Cảm ơn các bác. Em đã mò được rồi.