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

se7en

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

  • Số lượng nội dung

    52

  • Đã tham gia

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

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

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

    Chào bạn se7en,

    Nếu bạn chọn các đối tượng của bộ lựa chọn theo phương pháp pick từng chú một thì thứ tự các đối tượng trong bộ lựa chọn sẽ theo đúng trình tự bạn pick.

    Với các cách chọn lựa các đối tượng của bộ lựa chọn khác thì mình không rõ bạn ạ.

    Vậy nên nếu bạn không ngại pick thì có thể sử dụng biện pháp này để sắp xếp lại thứ tự các đối tượng trong bộ chọn bạn ạ.

    Còn nếu chỉ là đánh số thứ tự các đối tượng theo chiều kim đồng hồ thì trên diễn đàn đã có một vài lisp tương tự rồi. Bạn hãy chịu khó tìm kiếm một chút nhé.

    Chúc bạn thành công.

    Ở đây em chọn tất cả, chứ pick từng điểm thì không có gì phải bàn rồi, vì số lượng đối tượng của em trên bản vẽ là rất nhiều , gần 10.000 điểm, nếu pick từng điểm thì sẽ mất thời gian và sẽ có trường hợp pick nhầm nữa thì khổ cho nên e chọn hết tất cả rồi sau đó sort lại. Tuy nhiên khi sort không nhất thiết phải theo chiều kim đồng hồ, chỉ cần có 1 trật tự nào đó thôi (ngược chiều kim đồng hồ hay theo thứ tự trái-phải, trên- xuống....).

    Em cũng đã search nhưng k thấy có topic nào đề cập về vấn đề này trong VBA.

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

    cái này gần giống công việc của mình tuy nhiên các 1 chỗ là file dữ liệu mình chỉ có text chứ không có đối tượng điểm. Bạn thử đoạn code dưới xem sao. File excel lưu o ổ C (c:\exportlevel.xls)

     

    Sub ExportLevel()
Dim SSet As AcadSelectionSet
Dim Count, i, E, N As Double
Dim check As Boolean
Dim TextLocation As Variant
Dim EL As String

'---------------------------------------------------
Dim ExcelApp As Object
Set ExcelApp = CreateObject("Excel.application")
'Set ExcelApp = New Excel
ExcelApp.workbooks.Add
ExcelApp.cells(1, 1).Formula = "Point"
ExcelApp.cells(1, 2).Formula = "Northing"
ExcelApp.cells(1, 3).Formula = "Easting"
ExcelApp.cells(1, 4).Formula = "Elevation"

'----------------------------------------------------
'Check selectionset
Count = ThisDrawing.SelectionSets.Count
check = False
If Count > 0 Then
For i = 0 To Count - 1
	If ThisDrawing.SelectionSets.Item(i).Name <> "SSet" Then
		check = False
	Else
		check = True
		Exit For
	End If
Next i
End If

If check = False Then
Set SSet = ThisDrawing.SelectionSets.Add("SSet")
Else
Set SSet = ThisDrawing.SelectionSets.Item(i)
SSet.Clear
End If

SSet.SelectOnScreen

For i = 1 To SSet.Count
TextLocation = SSet.Item(i - 1).InsertionPoint
E = TextLocation(0)
N = TextLocation(1)
EL = SSet.Item(i - 1).TextString

ExcelApp.cells(i + 1, 1).Formula = i
ExcelApp.cells(i + 1, 2).Formula = Round(N, 3)
ExcelApp.cells(i + 1, 3).Formula = Round(E, 3)
ExcelApp.cells(i + 1, 4).Formula = EL

Next

ExcelApp.ActiveWorkbook.SaveAs "C:\ExportLevel.xls"
ExcelApp.Application.Quit
Set ExcelApp = Nothing
MsgBox "Finished !"

End Sub

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

    Em viết 1 code, chọn 1 tập hợp điểm (ssetP)rồi sau đó pick 1 điểm gốc (base point), code sẽ ghi khoảng cách từ điểm gốc đến các điểm còn lại trong tập hợp theo kiểu ghi bán kính. Giả sử tập hợp e toàn đối tượng điểm không có đối tượng khác. Nhưng khi chạy bị báo lỗi "Object was erased". Không biết em đã viết sai chỗ nào. Mọi người xem giúp em

    Ecám ơn nhiều.

     

    Sub P2P()
Dim SSetP As AcadSelectionSet
Dim i As Integer
Dim BasePoint As Variant
Dim check As Boolean

'Check selectionset
check = False
If ThisDrawing.SelectionSets.Count > 0 Then
For i = 0 To ThisDrawing.SelectionSets.Count - 1
	If ThisDrawing.SelectionSets.Item(i).Name <> "SSetP" Then
		check = False
	Else
		check = True
		Exit For
	End If
Next i
End If

If check = False Then
Set SSetP = ThisDrawing.SelectionSets.Add("SSetP")
Else
Set SSetP = ThisDrawing.SelectionSets.Item(i)
SSetP.Clear
End If
SSetP.SelectOnScreen

BasePoint = ThisDrawing.Utility.GetPoint

Dim dimObj As AcadDimRadial
For i = 0 To SSetP.Count - 1
Set dimObj = ThisDrawing.ModelSpace.AddDimRadial(BasePoint, SSetP.Item(i), 1)
Next
ZoomAll

End Sub

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

    Sửa dòng sau cho chính đúng:

    Cái này bắt phải bắt đầu từ 0 (CAD nó quy định thế)

    For i = 0 to sset.count-1

     

    Dim stPoint, ndPoint as Object
  Dim Length as Double
  Dim Radius as Double

  For i = 0 to sset.count-1
 select case sset.Item(i).ObjectName
   case "AcDbPoint" 'là điểm
	 redim stPoint(2)
	 stPoint(0) = sset.Item(i).Coordinate(0)
	 stPoint(1) = sset.Item(i).Coordinate(1)

   case "AcDbLine" 'là đường thẳng
	 stPoint=sset.Item(i).StartPoint
	 stPoint=sset.Item(i).EndPoint

   case "AcDbLCircle" 'là đường tròn
	 Radius =sset.Item(i).Radius 'or Diameter

   'là lightweight polyline 'là polyline  'là 3D polyline
   case "AcDbPolyline" , "AcDb2DPolyline" , "AcDb3dPolyline"
	 Length = sset.Item(i).Length

   ...

 end select 
  next i

     

    ý em là làm sao lưu lại đối tượng vào biến luôn, vì sau này em còn xử lý trên đối tượng đó nữa.

    Thanks

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

    Em chọn 1 số đối tượng bằng method selectonscreen của selectionset. tập hợp này gồm các đối tượng điểm, polyline, circle. Giờ e muốn lấy thuộc tính như sau : điểm thì lấy tọa độ, polyline thì lấy chiều dài, vòng tròn thì lấy bankính. Nhưng em không biết trả về cho đúng từng đối tượng ntn trong tập hợp đó.

    For i = 1 to sset.count

    nếu i là điểm thì thông báo tọa độ.

    nếu i là polyline thì thông báo chiều dài.

    nếu i là circle thì thông báo bán kính.

    next

     

    Em tự học vba trong cad nên hơi gà. Mong chỉ giáo.

    Thanks.

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

    Tức là trong file output.txt ko có stt 1,2,3,4... nữa hay là trong bản vẽ ko có text 1,2,3,4... nữa? 2 cái viết khác nhau.

    Nếu chỉ là xoá stt trtong file output.txt thì sửa lại như sau:

    (defun c:ltt()
 (setq ss (ssget "X" '((0 . "Point")))
file (open "output.txt" "w")
L nil)
 (while (and ss (> (sslength ss) 0))
   (setq ent (ssname ss 0)
  tt10 (cdr (assoc 10 (entget ent)))
  ss1 (ssget "c" (polar (polar tt10 0 2.5) (/ pi 2) -2.5)
	     (polar (polar tt10 0 -2.5) (/ pi 2) 2.5) '((0 . "TEXT")))
   )
   (while (and ss1 (> (sslength ss1) 0))
     (setq ent1 (ssname ss1 0)
    tt1 (cdr (assoc 1 (entget ent1))))
     (if (vl-string-search "." tt1)
(setq docao tt1)
(setq stt tt1))
     (ssdel ent1 ss1)
   )
   (if (and stt docao)
     (setq L (cons (cons stt (list (strcat (rtos (car tt10) 2 4) " " (rtos (cadr tt10) 2 4) " " docao))) L))
   )
   (ssdel ent ss)	  
 )
 (if L
   (progn
     (setq L (vl-sort L '(lambda(v1 v2) (< (car v1) (car v2)))))
     (foreach v L (write-line (cadr v) file))
   ))
 (close file)
)

     

    a thêm dùm em trường hợp trên bản vẽ không có stt đi, vì có thể e sẽ tắt lớp này đi cho đỡ rối bản vẽ. E sẽ thử test trên bản vẽ thực tế ntn vì file sample e đưa ra chỉ có vài điểm...còn thực tế thì nó có đến cả ngàn điểm...

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

    trình tự test:

    - mở file bản vẽ cảu bạn.

    - gõ ap , chọn đg dẫn đến file có chứa lệnh ltt. Xem load có thành công ko (successfully loaded).

    - gõ ltt.

     

    ltt nil là CT đã chạy xong rồi đó, kiểm tra xem có file output.txt trong cùng thư mục có bản vẽ (nếu khi mở bản vẽ bạn nhấp đúp vảo tên file)

    hoặc ở thư mục gốc của cad (Autocad 200X) của bạn nếu bạn nhấp đúp acad.exe.

    Em không để ý nên không biết, tại lisp chạy xong chẳng thấy báo gì ..heheh..., kiểm tra thì nó nằm ngay thư mục bản vẽ

    Anh ơi, giờ e bỏ không dùng stt nữa, vì xuất sang bình đồ thì stt không còn ý nghĩa, a có thể sửa lại dùm em chỉ có toadox toadoy caodo thôi được không ? Cám ơn anh nhiều...

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

    Trước tiên bạn fải có 1 macro để load form của bạn tạm gọi là OpenCTMForm nằm trong Module1

    1. Bạn chọn property của cái button bạn vừa tạo . trong ô Macro associated with this button gõ vào.

    -vbarun Module1.OpenCTMForm

    Nhấn Ok. Thế là mỗi khi bạn nhấn button sẽ open form CTM.

     

    2. Đối với Menu thì bạn gán cho nó là được :

    ThisDrawing.Application.MenuBar.Item(index).Item(index).Macro = "(command ""vbarun"" ""OpenCTMForm"")" + vbCr

    Với index là chỉ số của menu và sub-menu lenh1 của bạn.

     

    Thân

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

    Nhờ các ace giúp em cái này...e có 1 file cad 2D, gồm các các điểm, lân cận điểm có các text thể hiện thông tin của điểm như số thứ tự, cao độ của điểm (xem file đính kèm : http://www.cadviet.com/upfiles/Drawing1_45.dwg ). Vấn đề của em là bây giờ e muốn viết 1 code để sao có thể xuất hết các thông tin này thành 1 file excel hay text với định dạng:

    stt toadox toadoy docao

     

    cụ thể áp dụng cho file này :

    1 8.7320 11.8432 0.02

    2 18.4642 20.9190 0.10

    3 37.6395 19.6864 0.02

    4 43.8070 11.0028 1.25

    5 27.6033 4.2800 -1.20

     

    Nếu file này là file 3D thì không thành vấn đề rồi, ngặc nỗi là 2D, và cái cao độ là 1 đối tượng text riêng lẽ, e không biết làm như thế nào cả. ACE nào có thể giúp e cái code hay hướng dẫn cách giải quyết thì chỉ em cũng được, em từ từ làm. Hiện nay hướng giải quyết của em là chuyển sang file dxf, vì nghe nói dxf có thể truy xuất được thông tin với dạng text file, e tính tìm vị trí các điểm và các text cao độ trong text file của dxf, sau đó tìm cách gắn cao độ tương ứng với vị trí của điểm. nhưng thấy tương lai mù mịt quá...heheheh...đó là suy nghĩ giải fáp của em vì đến giờ cũng không biết làm sao nhận biết thông tin tọa độ trong file text của dxf.

    Em cám ơn nhiều...

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

    Bạn muốn tại bộ setup thì mình gioi thiệu bạn bộ phần mềm MindVision Installer Vise - cái này dùng khá hay. có thể giải quyết các vấn đề liên quan đến việc tạo bộ setup cho riêng mình - tuy nhiên nên đọc kỹ cách sử dụng để fát huy hết chức năng của nó...mình thấy nó khá pro...he...he...

    Còn tự động kích hoạt menu trong CAD thì bạn fải viết riêng thêm trong CAD + vise = đúng như ý bạn...

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

    Mình thường xuyên phải tính diện tích các ao mương san lấp nhưng file khảo sát về các đường người ta vẽ bằng SPLINE nên mình không dùng các lisp ở trên diễn đàn tính được, mỗi khi tính phải bo vùng kín lại bằng lệnh PLINE rồi dùng lệnh AREA (Vì mình còn tính cả chu vi nữa) mất rất nhiêug thời gian. Mình mong muốn các bạn viết dùm mình 1 lisp khi ta chọn một vùng kín (vùng kín vẽ bằng PLINE vì mình nghĩ SPLINE chắc không được) thì sẽ điền diện tích và chu vi vùng kín lên bản vẽ. Rất mong các bạn giúp đỡ. Cảm ơn trước hen!!!

    SPL vẫn có thế tính diện tích bình thường mà, bạn đâu cần fải bo vùng kín bằng pline mà bo bằng pling thì nếu phạm vi lớn sẽ thiếu chính xác. Bạn dùng tham số Object trong lệnh Area sẽ tính được diện tích và chu vi của 1 spline kín.

    còn lisp như bạn yêu cầu bạn có thể search trong diễn đàn vì đã có bài viết đề cập đến vđề này.

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

    Để xây dựng đường đồng mức, thì trước tiên bạn fải xây dựng được mô hình TIN, thuật toán xây dựng mô hình TIN có rất nhiều, thừơng sử dụng nhất là xây dựng hệ thống lưới tam giác Delauney. Sau đó bạn có thể dựa trên hệ thống này để nội suy ra các điểm có cùng cao độ, tập hợp các điểm cùng độ cao sẽ cho ra 1 đường đồng mức. Nói chung thuật toán tương đối phức tạp.

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

    hi, everybody!

     

    file *.dwg in ra giấy A4 thường có chút xíu à, ko có to bằng khổ giấy A4 hoặc là hình thiết kế ko có lớn. mình mún chỉnh lớn để in ra thì làm sao? hoặc in lớn tửng phần của bản vẽ thì sao???

     

    bạn nào bít chi giúp cách đơn giản nhất ^^, thanks nhiều!!!

    Bạn đã kiểm tra các thông số thiết lập trong plot chưa ? chẳng hạn như máy in, khổ giấy tương ứng, tỷ lệ...

    Nếu muốn in full trong A4 thì bạn chọn paper A4 cho máy in, nếu không cần tỉ lệ thì chọn scale to fit, nếu có tỉ lệ thì bạn tỉ lệ tương ứng với bản vẽ của bạn trong Plot scale với điều kiện là tỷ lệ này fải fit với A4. Nếu trong model thì bạn click vào nút window sau đó chọn vùng cần in. rùi full preview thử xem có in được hết trang không?

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

    Mới sưu tầm cái lisp ghi diện tích của boundary và liên kết diện tích với boundary đó, nghĩa là khi thay đổi boundary, diện tích tự động thay đổi theo. lệnh có hai tùy chọn: B dùng để tạo boundary và ghi diện tích; L để ghi diện tích cho boundary có sẵn. Tặng các bạn , ai thích thì xài:(lệnh là tarb)

    (defun ufa (notifier-object reactor-object parameter-list) 
 (vl-load-com) 
 (cond 
   ((vlax-property-available-p notifier-object "Area") 
    (setq actDoc 
    (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (vla-SAVE actDoc) 
   ) 
 ) 
) 


(defun plar(/ pt pt1 pt2) 
(setq pt (getpoint"\nStarting Point: ")) 
(setq pt1 (getpoint pt "\nNext Point: ")) 
(command "Pline" pt pt1 "") 
  (while 
      (setq pt2 (getpoint pt1"\nNext Point: ")) 
     (command "pline" "" pt2 "") 
     (command "pedit" pt "j" pt pt2 "" "") 
     (setq pt1 pt2) 
  ) 
(command "pedit" pt "c" "") 
(princ) 
) 

(defun ar5 () 
(SETQ A NIL)
(vl-load-com) 

 (setq cm (getvar "cmdecho")) 
 (setvar"cmdecho" 0) 
 (setq fd (getvar "fielddisplay")) 
 (if (/= fd 0)(setvar"fielddisplay" 0)) 

   (setq ar1 (entsel "\nSelect Area Boundary: ")) 
   (setq ar2 (car ar1)) 
   (setq tab (vlax-ename->vla-object ar2)) 
   (setq oba (vla-get-objectid tab)) 

(setq lu (getvar "lunits")) 
(setq tpt (getpoint"\nSelect Area Text Point: ")) 
(cond 
((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu6%qf1\">%"))) 
((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%"))) 
((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu5\">%"))) 
((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                   (rtos oba 2 0) ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%"))) 
((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
                                    (rtos oba 2 0) ">%).Area \\f \"%lu1\">%"))) 
) 
(command "mtext" tpt "w" "0" lin "") 
(setq plineReactor (vlr-object-reactor (list tab)  "pline Reactor" '((:vlr-modified . ufa))))

(princ) 
)       

(defun c:tarb (/ key) 
(initget  1 "Boundary/label-area Label-area") 
(setq key (getkword "\nWould you like Boundary/label-area or Label-area: ")) 
  (cond 
    ((= key "Boundary/label-area")(plar)(ar5)) 
    ((= key "Label-area")(ar5)) 
  ) 
(princ) 
)

     

    CAD báo lỗi bạn ơi : ; error: AutoCAD variable setting rejected: "fielddisplay" 0

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

    Đã kiểm tra rồi. file bản vẽ mình tạo trên máy tính để bàn, font VNI-HELVE CONDENSEN dùng bộ gõ UNIKEY để gõ tiếng việt. Mọi thứ OK. Sau đó mang sang laptop thì không làm được như thế này nữa : nhấn giữ Alt + 0222 = kí hiệu đường kính. Dù đã tắt Unikey . Có gì mình chưa biết chăng ?

    vậy bạn kiểm tra trên laptop bạn có font vni-helve condense chưa (trong control panel/font) ? file cad copy vào laptop nhưng nếu không có font tương ứng trên máy thì cũng có thể gây ra trường hợp như vậy.

    Nếu vẫn không được, bạn có thể chuyển sang sử dụng font khác, và để biết được cách gõ ký hiệu đường kính cho từng loại font, bạn dùng Character Map có sẵn của windows.

    cái này không liên qua đến bộ gõ.

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

    Trên màn hình Cad có các text: textA, textB, textC,...textN; Sử dụng lisp để ghi các text trên vào file Excel đã có trên đĩa, ví dụ file *.xls đã có dữ liệu đến row 15, ghi tiếp các text trên vào row 16 như sau: textA ghi vào cell A16, textB vào cell B16, textC vào cell C16,... textN vào cell N16.

    Nhờ các Bác viết hộ lisp để thực hiện được yêu cầu trên, cám ơn trước

    Nếu bạn dùng VBA thì dùng cái này xem sao.CommonDialog của mình bị lỗi nên fải dùng inputbox hơi bất tiện,bạn có thể chỉnh lại cái này trong code.

     

    Sub GetText()
Dim sset As AcadSelectionSet
Dim checkSS As Boolean
Dim row, i As Double
Dim Text As AcadText
Dim MText As AcadMText

checkSS = False
For i = 1 To ThisDrawing.SelectionSets.count
   If ThisDrawing.SelectionSets.Item(i - 1).Name = "SSET" Then
       Set sset = ThisDrawing.SelectionSets.Item(i - 1)
       sset.Clear
       checkSS = True
       Exit For
   Else
       checkSS = False
   End If
Next

If checkSS = False Then Set sset = ThisDrawing.SelectionSets.Add("SSET")

sset.SelectOnScreen
If sset.count = 0 Then Exit Sub

'-------------------------------------
Dim ExcelApp As Object
Dim CheckData As Boolean
Dim PathFile As String
CheckData = False
Set ExcelApp = CreateObject("Excel.application")
PathFile = InputBox("Nhap vao duong dan day du cua file", "Full path")
ExcelApp.workbooks.Open PathFile
row = 1
While CheckData = False
   If ExcelApp.cells(row, 1).Formula <> "" Then
       CheckData = False
       row = row + 1
   Else
       CheckData = True
   End If
Wend
For i = 0 To sset.count - 1
   Select Case sset.Item(i).ObjectName
       Case "AcDbText"
           Set Text = sset.Item(i)
           ExcelApp.cells(row, 1 + i).Formula = Text.TextString
       Case "AcDbMText"
           Set MText = sset.Item(i)
           ExcelApp.cells(row, 1 + i).Formula = MText.TextString
   End Select
Next

ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWorkbook.Close
ExcelApp.Application.Quit
Set ExcelApp = Nothing

End Sub

    • Vote tăng 1

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

    Dùng máy tính để bàn để vẽ CAD, cần đánh kí hiệu đường kính thì nhấn giữa Alt + 0223 thì ok nhưng ko làm thế được với laptop !?!?!?! tại sao vậy ?

    cái này còn tùy vào bộ font bạn đang dùng nữa.bạn kiểm tra lại font trong text style trên laptop của bạn có giống như trong text style trên máy để bàn không thì khi đó Alt+0223 mới cho ra ký hiệu đường kính.

×