Chuyển đến nội dung
Diễn đàn CADViet

huunhantvxdts

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    857

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    40

Bài đăng được đăng bởi huunhantvxdts

  1. Đã đăng · Trả lời báo cáo

    Lâu rồi mình k viết VBA nên quên hết rồi, giờ đọc code của bạn hơi ngại ^^. Tuy nhiên việc thay khai báo x bằng vị trí bạn có thể cho nó vào 1 đối số của func / sub, và dùng acadutility để lấy tọa độ người pick gán cho hàm, chắc chắn là không khó đâu

    - Add dữ liệu nếu k làm form bạn có thể làm gọn đi, chỉ hiện những thứ - sheet cần thiết cho quá trình nhập liệu thì đỡ rối mắt hơn ^^

    ok. mình chỉ cần lấy tọa độ vừa pick cho vào vị trí x y là được phải không???

    vậy để mình tìm xem cấu trúc lệnh lấy tọa độ rồi bổ sung thêm

  2. Đã đăng · Trả lời báo cáo

    Bạn format trước khi ghi ra

    MyStr = Format(2.5, "###0.00") ' Returns "2.50"

    ​ Good luck!

    để mình sữa lại

    Cám ơn bạn đã chỉ cách

    mình đang viết 1 ứng dụng nên có những cái vướng mắc. cũng nhờ các bạn chỉ cách nên bây giờ cũng tương đối hoàn thiện. Nếu bạn quan tâm thì vào đây http://www.cadviet.com/forum/index.php?showtopic=61127&pid=185701&st=0&&do=findComment&comment=185701

  3. Đã đăng · Trả lời báo cáo

    Ứng dụng tốt,vì mình không có chuyên ngành nên cũng không biết mức độ hoàn thiện. Chỉ có vấn đề là nếu bạn không cung cấp lựa chọn điểm đặt thì tất cả đều vẽ lên 1 chỗ à ^^

    Khi muốn thêm tọa độ tiếp theo thì phải copy , insert khá phiền phức, bạn có thể cung cấp giao diện add vào cho thân thiện :)

    Ở bảng excell mình có tọa độ đầu bảng x,y (tạo độ điểm chèn) rồi

    muốn đặt ở đâu thi chỉ việc thay đổi tạo độ

    còn giao diện thì mình không biết làm

    mình gà lắm như mình nói ở trên đây là ứng dụng mà mình tự viết mà chủ yếu là lượm lặt các câu lệnh rồi chế lại. cái nào mà không chạy được thì lên mạng hỏi thêm. còn việc làm giao diện rồi add vào thì mình không thể làm được (không biết làm thế nào cả)

    Cám ơn bạn đã quan tâm nếu được bạn có thể chỉnh sữa lại cho hoàn thiện hơn

    Cám ơn bạn 1 lần nữa

    • Vote tăng 1

  4. Đã đăng · Trả lời báo cáo

    Sau 1 thời gian mày mò mình đã thêm bớt một số cái (hay còn gọi là nâng cấp hoàn thiện hơn) mong mọi người có ý kiến thêm
    Rất cám ơn mọi người quan tâm
    Đây ứng dụng mình tự mày mò nên chủ yếu là mình cần cái gì mình bỏ sung thêm cái đó. về giải thuật theo đánh giá của mình là thủ công. nhưng khi chạy ứng dụng thì cũng tạm ổn. đỡ phải vẽ cad.
    để chạy ứng dụng
    1. tải file đính kèm (Excell)
    2. mở autocad 2008 (mình mởi thử ở phiên bản này, các phiên bản khác mình chưa thử)
    3. mở file excell ( excelll 2003) vừa tải. nhập vào những giá trị thiết kế cơ bản (Cao độ TK, Cao độ TN, Lý trình.....)
    4. Bây giơ chỉ pick chuột vào " VẼ CỐNG HOÀN THIỆN"
    Đây là link down mới
    http://www.4shared.com/office/stn_vCOR/Ve_cong_moi.html

    đây là code

    Private Sub TaoLayers()
Dim duongtk As AcadLayer
Dim duongtn As AcadLayer
Dim duongdg As AcadLayer
Dim duonghg As AcadLayer
Dim duongcg As AcadLayer
Dim duongkg As AcadLayer
Dim loptext As AcadLayer
Dim layertypeName As String
layertypeName = "center"
Set duongtk = AcadApplication.ActiveDocument.Layers.Add("duongthietke") 'Tao layer "duong thiet ke"
duongtk.Color = acRed 'chon màu nét cua Layer "duongthietke"
On Error Resume Next
AcadApplication.ActiveDocument.Linetypes.Load layertypeName, "acad.lin" 'Load kieu nét ACAD_ISO03W1000 de san sàng các layers có the su dung
Set duongtn = AcadApplication.ActiveDocument.Layers.Add("duongtunhien") 'tao layer "duongtunhien"
duongtn.Color = acGreen
duongtn.Linetype = "continuous" 'chon kieu net cho layer "duong tu nhien"
Set duongdg = AcadApplication.ActiveDocument.Layers.Add("duongdong") 'tao layer "duong dong"
duongdg.Color = 8
duongdg.Linetype = "continuous" 'chon kieu net cho layer "duong dong"
Set duonghg = AcadApplication.ActiveDocument.Layers.Add("hoga") 'tao layer "duong ho ga"
duonghg.Color = acBlue
duonghg.Linetype = "continuous" 'chon kieu net cho layer "duong ho ga"
Set duongcg = AcadApplication.ActiveDocument.Layers.Add("Cong") 'tao layer "duong cong"
duongcg.Color = acRed
duongcg.Linetype = "continuous" 'chon kieu net cho layer "duong cong"
Set duongkg = AcadApplication.ActiveDocument.Layers.Add("duongkhung") 'tao layer "duong khung"
duongkg.Color = acGreen
duongkg.Linetype = "continuous" 'chon kieu net cho layer "duong khung"
Set loptext = AcadApplication.ActiveDocument.Layers.Add("text") 'tao layer "text"
loptext.Color = acRed
End Sub
Sub TaoTextStyle()
Dim TextStyleObj As AcadTextStyle
Set TextStyleObj = ActiveDocument.TextStyles.Add("chuhoa")
TextStyleObj.SetFont ".VnArial NarrowH", True, False, 0, 34
Set TextStyleObj = ActiveDocument.TextStyles.Add("chuso")
TextStyleObj.SetFont ".VnArial Narrow", True, False, 0, 34
End Sub
Sub VeLine1(cott1 As Integer, cott2 As Integer)
Dim cong As AcadLine
Dim offset As Variant
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim i As Double
Dim j As Double
i = 13
j = i + 1
Do While Not Sheets("Vecong").Cells(j, cott1).Value = ""
x1(0) = Sheets("Vecong").Cells(i, cott1)
x1(1) = Sheets("Vecong").Cells(i, cott2)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(j, cott1)
x2(1) = Sheets("Vecong").Cells(j + 1, cott2)
x2(2) = 0

Set cong = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
offset = cong.offset(Sheets("vecong").Cells(j, 11))
i = i + 2
j = j + 2
Loop
Set cong = Nothing
'ZoomAll
End Sub
Sub VeLine(cot1 As Integer, cot2 As Integer)
Dim blk As AcadLine
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim i As Double
Dim j As Double
i = 13
j = i + 2
Do While Not Sheets("Vecong").Cells(j, cot1).Value = ""
x1(0) = Sheets("Vecong").Cells(i, cot1)
x1(1) = Sheets("Vecong").Cells(i, cot2)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(j, cot1)
x2(1) = Sheets("Vecong").Cells(j, cot2)
x2(2) = 0
Set blk = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
i = i + 2
j = j + 2
Loop
Set blk = Nothing
'ZoomAll
End Sub
Sub duongkhung()
Dim linebang As AcadLine
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim offset As Variant
Dim i As Integer
x1(0) = Sheets("Vecong").Cells(13, 31)
x1(1) = Sheets("Vecong").Cells(13, 32)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(15, 31)
x2(1) = Sheets("Vecong").Cells(15, 32)
x2(2) = 0
Set linebang = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
i = 5
Do While i <= 14
offset = linebang.offset(Sheets("Bangbieu").Cells(i, 3))
offset(0).Update
i = i + 1
Loop
Set linebang = Nothing
End Sub
Sub moautocad()
Dim acadapp As AcadApplication
On Error Resume Next
Set acadapp = GetObject(, "autocad.application")
If Err Then
Err.Clear
Set acadapp = GetObject("autocad.application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadapp.Visible = True
If acadapp.WindowState = acMax Then acadapp.WindowState = acMin
acadapp.WindowState = acMax
'MsgBox " Dang chay " + acadapp.Name + " phien ban " + acadapp.Version
End Sub
Sub veply(cot1 As Integer, cot2 As Integer, cot3 As Integer)
Dim ply As AcadPolyline
Dim x(0 To 11) As Double
Dim i As Integer
Dim j As Integer
i = 12
j = i + 1
Do While Not Sheets("Vecong").Cells(j, cot1).Value = ""
x(0) = Sheets("Vecong").Cells(i, cot1)
x(1) = Sheets("Vecong").Cells(j, cot2)
x(2) = 0
x(3) = Sheets("Vecong").Cells(i, cot1)
x(4) = Sheets("Vecong").Cells(j, cot3)
x(5) = 0
x(6) = Sheets("Vecong").Cells(j, cot1)
x(7) = Sheets("Vecong").Cells(j, cot3)
x(8) = 0
x(9) = Sheets("Vecong").Cells(j, cot1)
x(10) = Sheets("Vecong").Cells(j, cot2)
x(11) = 0
Set ply = AcadApplication.ActiveDocument.ModelSpace.AddPolyline(x)
i = i + 2
j = j + 2
Loop
Set ply = Nothing
'ZoomAll
End Sub
Sub duongdong(cot1 As Integer, cot2 As Integer, cot3 As Integer)
Dim duong As AcadLine
Dim x1(0 To 2) As Double
Dim x2(0 To 2) As Double
Dim i As Double
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x1(0) = Sheets("Vecong").Cells(i, cot1)
x1(1) = Sheets("Vecong").Cells(i, cot2)
x1(2) = 0
x2(0) = Sheets("Vecong").Cells(i, cot1)
x2(1) = Sheets("Vecong").Cells(i, cot3)
x2(2) = 0
Set duong = AcadApplication.ActiveDocument.ModelSpace.AddLine(x1, x2)
i = i + 2
Loop
Set duong = Nothing
'ZoomAll
End Sub
Sub diengiatritext(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim giatritext As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("Bangbieu").Cells(hang, 13)
x(2) = 0
noidung = Sheets("vecong").Cells(i + 1, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set giatritext = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
giatritext.Alignment = acAlignmentMiddleCenter
giatritext.TextAlignmentPoint = x
gocnghieng = 0 / 180 * 3.14159
giatritext.Rotate x, gocnghieng
giatritext.Update
i = i + 2
Loop
Set giatritext = Nothing
'ZoomAll
End Sub
Sub diencaodo(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("Bangbieu").Cells(hang, 13)
x(2) = 0
noidung = Sheets("vecong").Cells(i, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentMiddleCenter
caodo.TextAlignmentPoint = x
gocnghieng = 90 / 180 * 3.14159
caodo.Rotate x, gocnghieng
caodo.Update
i = i + 2
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub dienchenhcao(cot1 As Integer, cot2 As Integer, cot3 As Integer)
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("vecong").Cells(i, cot3)
x(2) = 0
noidung = Sheets("vecong").Cells(i, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentLeft
gocnghieng = 90 / 180 * 3.14159
caodo.Rotate x, gocnghieng
caodo.Update
i = i + 2
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub diendaubang()
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim j As Integer
AcadApplication.ActiveDocument.ActiveTextStyle = AcadApplication.ActiveDocument.TextStyles("chuhoa")
j = 5
Do While Not IsEmpty(Sheets("Bangbieu").Cells(j, 2))
x(0) = Sheets("Bangbieu").Cells(1, 8)
x(1) = Sheets("Bangbieu").Cells(j, 13)
x(2) = 0
noidung = Sheets("Bangbieu").Cells(j, 2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentMiddleCenter
caodo.TextAlignmentPoint = x
caodo.Update
j = j + 1
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub dienhoga(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim caodo As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not Sheets("Vecong").Cells(i, cot1).Value = ""
x(0) = Sheets("vecong").Cells(i, cot1)
x(1) = Sheets("Bangbieu").Cells(hang, 13)
x(2) = 0
noidung = Sheets("vecong").Cells(i, cot2).Value
hchu = Sheets("vecong").Cells(2, 8).Value
Set caodo = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
caodo.Alignment = acAlignmentMiddleCenter
caodo.TextAlignmentPoint = x
gocnghieng = 0 / 180 * 3.14159
caodo.Rotate x, gocnghieng
caodo.Update
i = i + 2
Loop
Set caodo = Nothing
'ZoomAll
End Sub
Sub laydiemdat()
Dim xpoint As AcadUtility
Dim ypoint As AcadUtility
Dim point As Variant

'MsgBox ("Diem dat trac doc")
'point = AcadApplication.ActiveDocument.ModelSpace.AddPoint("nhap mot diem")
'AcadApplication.ActiveDocument.Utility.Prompt (vbCrLf & " Diem dat trac doc")
point = AcadApplication.ActiveDocument.Utility.GetPoint(, "diem dat trac doc")
Sheets("Vecong").Cells(2, 5) = point(0)
Sheets("Vecong").Cells(3, 5) = point(1)
'AcadApplication.ActiveDocument.UserCoordinateSystems.Add , point(0), point(1), ""
End Sub
Private Sub CommandButton1_Click()
'day cong
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("Cong")
Call VeLine1(15, 19)
End Sub
Private Sub CommandButton2_Click()
'dinh cong
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("Cong")
Call VeLine1(15, 21)
End Sub
Private Sub CommandButton3_Click()
'duong tu nhien
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongtunhien")
Call VeLine(14, 7)
End Sub
Private Sub CommandButton4_Click()
'duong thiet ke
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongthietke")
Call VeLine(14, 5)
End Sub
Private Sub CommandButton5_Click()
'day ho ga
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("hoga")
Call veply(15, 17, 23)
End Sub
Private Sub CommandButton6_Click()
'Dinh ho ga
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("hoga")
Call veply(15, 17, 5)
End Sub
Private Sub CommandButton7_Click()
'duong dong
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongdong")
Call duongdong(14, 5, 24)
End Sub
Private Sub CommandButton8_Click()
'Duong bao ho ga
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("hoga")
Call veply(25, 5, 27)
End Sub
Private Sub CommandButton9_Click()
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("text")
AcadApplication.ActiveDocument.ActiveTextStyle = AcadApplication.ActiveDocument.TextStyles("chuso")
'khoang cach le
Call diengiatritext(35, 30, 16)
'do doc doc
Call diengiatritext(36, 41, 17)
'duong kinh cong
Call diengiatritext(29, 40, 6)
End Sub
Private Sub CommandButton10_Click()
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("text")
'Cao do nap dan
Call diencaodo(14, 4, 8)
'Cao do day cong
Call diencaodo(14, 16, 9)
'Cao do day ho ga
Call diencaodo(14, 22, 10)
'do chenh cao TK - D.Cong
Call dienchenhcao(14, 37, 38)
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongtunhien")
'khoang cach cong don
Call diencaodo(14, 28, 7)
'Cao do tu nhien
Call diencaodo(14, 6, 11)
'Ki hieu ho ga
Call dienhoga(14, 2, 12)
'Ly trinh theo tuyen chinh
Call dienhoga(14, 3, 13)
End Sub
Private Sub CommandButton11_Click()
AcadApplication.ActiveDocument.ActiveLayer = AcadApplication.ActiveDocument.Layers("duongkhung")
Call duongkhung
Call duongdong(31, 32, 33)
Call duongdong(14, 24, 34)
Call duongdong(39, 32, 33)
End Sub
Private Sub CommandButton12_Click()
Call moautocad
Call TaoLayers
Call TaoTextStyle
Call laydiemdat
Call CommandButton1_Click
Call CommandButton2_Click
Call CommandButton3_Click
Call CommandButton4_Click
Call CommandButton5_Click
Call CommandButton6_Click
Call CommandButton7_Click
Call CommandButton8_Click
Call CommandButton9_Click
Call CommandButton10_Click
Call CommandButton11_Click
Call diendaubang
End Sub

    Cập nhật clip 

    https://www.youtube.com/watch?v=cjwuUw3sx5I

    Similar topics from web:
    VBA
    Thảo luận về Autolisp
    • Vote tăng 5

  5. Đã đăng · Trả lời báo cáo

    C1: Dùng biến hệ thống CLAYER và TEXTSTYLE

    ThisDrawing.setvar "VARIABLE_NAME",VALUE

    C2 :

    ThisDrawing.ActiveLayer = ThisDrawing.Layers("ActiveLayer")

    ThisDrawing.ActiveTextStyle = ThisDrawing.Textstyle ("styleName")

     

    Goodluck!

    Cám ơn bạn đã giúp đỡ

    tiện đây cho mình hỏi làm thế nào để lấy dữ liệu kiểu số từ excell qua cad mà sau dấu chấm có 2 chữ số

    ở đây mình chỉ lấy được nó như thế này

    2.00 ---> 2

    2.50 ---> 2.5

    2.54 ---> 2.54

  9. Đã đăng · Trả lời báo cáo

    Đoạn code sau đây là lấy dữ liệu từ excel rồi ghi vào cad. nhưng tôi muốn các text viết ra có góc 90 độ so với phương ngang nhờ các Bác cao thủ sữa lại dùm. cám ơn các Bác đã quan tâm

    Sub diengiatritext(cot1 As Integer, cot2 As Integer, hang As Integer)
Dim giatritext As AcadText
Dim x(0 To 2) As Double
Dim hchu As Double
'Dim gocnghieng As Double
Dim noidung As String
Dim i As Integer
i = 13
Do While Not IsEmpty(Sheets("Vecong").Cells(i, cot1))
   	x(0) = Sheets("vecong").Cells(i, cot1)
   	x(1) = Sheets("Bangbieu").Cells(hang, 6)
   	x(2) = 0
   	noidung = Sheets("vecong").Cells(i + 1, cot2).Value
   	hchu = Sheets("vecong").Cells(2, 8).Value
   	'gocnghieng = Sheets("vecong").Cells(i, cot3).Value
   	Set giatritext = AcadApplication.ActiveDocument.ModelSpace.AddText(noidung, x, hchu)
   	giatritext.Color = acGreen
   	giatritext.Alignment = acAlignmentMiddleCenter
   	giatritext.TextAlignmentPoint = x
       giatritext.Rotate:' LOI O DONG NAY
       giatritext.Update
   	i = i + 2
Loop
Set giatritext = Nothing
ZoomAll
End Sub

  10. Đã đăng · Trả lời báo cáo

    Quy tắc là thế này, bạn chú ý những dòng sau theo thứ tự logic từ trên xuống dưới :

     

    - Dòng 1 có nghĩa là nếu chưa có biến am (am chưa có giá trị), chương trình sẽ đặt cho am giá trị bằng "1", nếu đã có thì giữ nguyên am để thực hiện hàm ngay sau nó ở dòng 2.

    2 dấu "" trước và sau số 1 hiển thị đây là 1 string (chữ)

    - Dòng 2 : Hàm strcat là hàm nối chuỗi, chỉ thực hiện khi tất cả các đối số đều là chuỗi(string).

    - Dòng 3 có nghĩa là nếu người dùng ấn H, hoặc h, thì chương trình sẽ yêu cầu bạn nhập giá trị mới cho am. Giá trị am được lấy bởi hàm Getstring, nên cũng vẫn mang định dạng là String

    - Dòng 4 có nghĩa là cố lấy số thực từ 1 string am, và gán ngược lại biến am, sau đó mới thực hiện các phép toán số học với 1 số thực am. Sau bước này định dạng của am đã là 1 số Real

     

    Bây giờ xét quá trình làm việc của lisp trong lần đầu tiên :

    - Sau khi kiểm tra điều kiện ở dòng 1, tất nhiên, lúc này am chưa được gán giá trị nào, nên chương trình sẽ đặt am = "1" (string)

    - Dòng 2 : strcat với các đối số toàn là chuỗi => OK

    - Dòng 3 : cũng vậy

    - Dòng 4 : am ( giả sử ta k đặt lại am ở bước 3 nhé) được đặt lại bằng 1 (số thực) và thực hiện lisp

    => OK

    Lần thứ 2 chạy lisp :

    - Biến am đã được đặt là 1 ở dòng 4 của lần chạy đầu tiên

    - Khi thực hiện đến dòng thứ 2, hàm strcat không thể nối các chuỗi khi mà thằng am bản thân của nó không phải là chuỗi => Lỗi

    Cách đơn giản nhất để sửa là lại biến am thành string từ giá trị thực ở cuối chương trình để lần sau am vẫn là string cho đến trước khi tính toán số học.

    Có thể sử dụng hàm rtos : (setq am (rtos am))

    Làm được rồi cảm ơn bạn đã giup đỡ

  13. Đã đăng · Trả lời báo cáo

    Em sưu tầm và có chỉnh sửa lại theo những yêu cầu của mình nhưng khổ nổi nó chỉ chạy được lần đầu tiên còn các lần sau nó đều báo lổi nhờ các bác ai biết sửa lại cho em:

    (Defun c:TDT()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "osnap" "none")
(if (null am)(setq am "1"))
(Setq temp1 T)
(While temp1
(setq pt (strcat "\nHe so ("am") \<Chon diem>: "))
(Initget "h H")
(setq str (getpoint pt))
(Cond
 ((= str "h") (setq am (getstring (strcat"\nNhap he so <"am"> :"))))
 ((= str "H") (setq am (getstring (strcat"\nNhap he so <"am"> :"))))
  (Progn
 (Setq pt str)
  (setq temp1 nil)
 )
)
)
(setq s 0)
(progn
;  (setq pt (getpoint "\n Chon diem: "))
  	(while pt
  (setq entold (cdr (assoc 5 (entget (entlast)))))
  (command "boundary" pt "")
  (setq entnew (cdr (assoc 5 (entget (entlast)))))
  (if (/= entold entnew)  
(progn
            			(setq entnew (entget (entlast)))
            			(if (assoc 62 entnew)
                       	(setq entnew (subst (cons 62 (+ 3 (cdr (assoc 62 entnew)))) (assoc 62 entnew) entnew))
                       	(setq entnew (append entnew (list (cons 62 (+ 3 (cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 entnew))))))))))
              			)


            			(entmod entnew)
            			(Command "area" "o" (entlast))
(setq s (+ s (getvar "area")))
   	(setq pt (getpoint "\n Chon diem: "))
(entdel (entlast))
  		)
(progn
(princ "chon diem sai")
(setq pt (getpoint "\n Chon diem: "))
)
  )
)
       	)

(command "osnap" "intersection")
(setq am (atof am))
(setq s (* s am))
(setq point (getpoint "\n Chon diem ghi dien tich: "))
(setq th (getvar "textsize"))
(setq th (getstring (strcat "\nChieu cao chu <"(rtos th)"> :")))
 ;(princ "\nDien tich nhung vung vua chon la: "s)
(command "TEXT" point th 0 (rtos s 2 2))
 (setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** TAILIEUKYTHUAT.COM")        
(princ )
)

  14. Đã đăng · Trả lời báo cáo

    Mình đã chạy thử nhưng lúc nào cao độ hố ga cũng là 1 đường thẳng tưng(cao độ đỉnh hố ga không thay đổi). Bạn nk-long có biết tại sao không?

    Với lại mình muốn hạ cao độ đỉnh HG xuống để lát gạch lên thi phải làm sao.

    cám ơn bạn rất nhiều, nhưng sao mình cài đặt không được mình dung cad 2008 và win7

  17. Đã đăng · Trả lời báo cáo

    cám ơn bạn đã dày công tạo 1 chương trình rất hay và chia sẽ cho mọi người

    Tôi đã sử dụng trên cad 2008 win7 thấy có lỗi như sau:

    chỉ xem và in được bản vẽ đầu tiên dù chương trình thông báo đúng số bản vẽ đã chọn

    rất mong bạn xem lại

  19. Đã đăng · Trả lời báo cáo

    Bài viết này vi phạm nội quy nhưng là thành viên mới nên tạm bỏ qua. Bạn tham khảo code sau nhé:

     

    Sub Example_Offset()
Dim lineObj As AcadLine
Dim line1Obj As Variant
Dim line2Obj As AcadLine

Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double

' Create a new line reference
startPoint(0) = 0: startPoint(1) = 0: startPoint(2) = 0
endPoint(0) = 2: endPoint(1) = 2: endPoint(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
line1Obj = lineObj.Offset(1)

Set line2Obj = ThisDrawing.ModelSpace.AddLine(lineObj.startPoint, line1Obj(0).endPoint)

Set line2Obj = Nothing
Set lineObj = Nothing
End Sub

     

    cám ơn bác đã chỉ dùm để em sữa lại code xem sao

    Bác có code nào hay share cho em với

     

    :(

  20. Đã đăng · Trả lời báo cáo

    giúp toi với làm sao để lấy toạ độ của đối tượng ofset line (endpoint và startpoin)

    chuong trinh cua toi nhu sau

     

    Option Explicit

    Sub veline()

    Dim line As AcadLine

    Dim diemdau As Variant

    Dim diemcuoi As Variant

    diemdau = ThisDrawing.Utility.GetPoint(, "nhap vao diem dau")

    diemcuoi = ThisDrawing.Utility.GetPoint(diemdau, "Nhap diem tiep theo")

    Set line = ThisDrawing.ModelSpace.AddLine(diemdau, diemcuoi)

    line.Update

    Dim line1 As Variant

    line1 = line.Offset(1)

    line1(0).color = 3

    MsgBox (line1(0).EndPoint(0))

    End Sub

×