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

ngokiet

Thành viên
  • Số lượng nội dung

    404
  • Đã tham gia

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

  • Ngày trúng

    43

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


  1. Bạn thử dùng lệnh _externalreferences để quản lý file chèn vào.

    Xem phần saved path có lưu hay không? Bạn có thể reload file thử xem.

    Đây là cách chèn file và khi chép file thì phải chép kèm.

    Nếu file cùng thư mục thì hình như nó tự động tìm.

     

    Còn có 1 cách khác khi chèn file hình là dùng Ctrl+C/Ctrl+V bình thường. Mở PS Chọn hình rồi copy qua cad Dán là xong. Không cần save .bmp

     


  2. 1 giờ} trướ}c, dotuanth đã nói:

    thiếu font nó phải báo lỗi. kiểu này nó không thấy đâu luôn

     

    Chắc là bác tắt báo lỗi khi thiếu font.

    - Xử lý bằng cách dùng lệnh st để xem style nào thiếu font thì chỉnh lại. 

    Dùng pu trước để xóa các style không cần thiết. Dùng ddim để xem kiểu dim nào lỗi.

    - Bạn có thể Ctrl+A để chọn tất cả để chỉnh về 1 style đúng.


  3. Giờ trên máy tính nên mình sửa 1 chút cho bạn theo ý bác @Danh Cong

    Bổ sung thêm có thể nhập lại khoảng cách from (Lúc nhập Angle thì nhấn D or Setdist)

     Sửa lại mới biết là khi dùng lệnh getangle thì có thể nhập góc bằng ký tự NEWS (Bắc Đông Tây Nam) Hic hic

    - Có 1 biến global là *offsets* để lưu khoảng cách offset.

     

    (defun c:ss(/ p1 p2 g1 sset cmd)
      (or (numberp *offsets*) (setq *offsets* 1000))
      (if (and (setq sset (ssget))
               (setq p1 (getpoint "\nFirst point : "))
               (setq p2 (getpoint p1 "\nFrom point : "))
           (progn
             (while (eq (progn
                  (initget "setDist")
                  (setq g1 (getangle p2 (strcat "\nDistance = "(rtos *offsets*) " ; Angle [setDist]:"))))
                "setDist")
               (If (setq g1 (getdist (strcat "Distance <" (rtos *offsets*) ">:"))) (setq *offsets* g1)))
             g1))
        (progn
          (setq cmd (getvar 'cmdecho))
          (setvar 'cmdecho 0)
          (command "stretch" sset "" "non" p1 "non" (polar p2 g1 *offsets*))
          (setvar 'cmdecho cmd))
        (princ "\nERROR: "))
      (princ))
          
          


  4. 17 phút trước, Danh Cong đã nói:

    Khi viết chương trình nhỏ đôi khi không cần phải đặt biến Osmode = 0.

    Ví dụ: (command ".LINE" "non" P1 "non" "P2" ""). Thì "non" có nghĩa là xóa tạm thời chế độ bắt điểm lúc này bằng 0, nó chỉ có tác dụng 1 lần duy nhất trước pick P1 thôi, vậy nên đến P2 lại phải đặt lại. :))) Hi vọng điều này hữu ích cho bạn.

    Mình cũng biêt nhưng mình ít sử dụng hàm command. Mình thích sửa trực tiếp hơn là command. Chẳng qua do bạn ấy muốn viết lisp nên mình làm theo form bạn ấy cho dễ hiểu để có thể tự chỉnh sửa theo nhu cầu của bạn ấy thôi. Còn sài hàm vl thì đở lỗi hơn.

     


  5. (defun c:ss(/ p1 p2 g1 sset)
      (if (and (setq sset (ssget))

               (setq p1 (getpoint "\nFirst point : "))

               (setq p2 (getpoint p1 "\nFrom point : "))

               (setq g1 (getangle p2 "\nAngle:")))
        (progn
          (setq p2 (polar p2 g1 1000)
            g1 (getvar 'osmode))
          (setvar 'osmode 0)
          (command "STRETCH" sset "" p1 p2)
          (setvar 'osmode g1))
        (princ "\nERROR: "))
      (princ))

     

    Mình sửa cho bạn như vậy trên ipad nên bạn xem thử như thế nào.

    Bạn cũng biết lisp nên mình nghĩ bạn biết nên xử lý thế nào. Còn nếu muốn preview nhiều thì khá phức tạp vì phải làm grread. Còn trả biến osmode thì do nhập giá trị nil nên hàm lỗi.

    • Like 1

  6. Thử lisp này xem

     

    (defun c:ss(/ p1 p2 g1 sset)
      (if (setq sset (ssget))
        (progn
          (setq p1 (getpoint "\nFirst point : ")
            p2 (getpoint "\nFrom point : ")
            g1 (getangle p2 "\nAngle:")
            p2 (polar p2 g1 1000)
            g1 (getvar 'osmode))
          (setvar 'osmode 0)
          (command "STRETCH" sset "" p1 p2)
          (setvar 'osmode g1))
        (princ "\nERROR: Nothing selected."))
      (princ))
          

    • Like 1

  7. Mình cũng không biết là bản vẽ như thế nào nên cũng chỉ góp ý 1 chút thôi.

    Dùng lệnh UpDateField chọn All xem thử có chậm không? 

    - Nó sẽ quét toàn bộ bản vẽ nếu có field sẽ cấp nhật tấ cả.

    Còn không thử dùng lisp này

     

    (defun c:rf()

      (command "updatefield" (ssget "all" '((0 . "*TEXT,INSERT"))) "")

      (princ))

     

    Tùy theo bản vẽ của bác như thế nào để lọc các đối tượng cần UpDateField cho nhanh. 

    Ở đây là mình chọn các text,mtext và block. Nếu không có block có field thì có thể bỏ cho nhanh.

    Bạn tìm hiểu thêm về lisp thì khi lọc càng nhiều đối tượng thì sẽ nhanh hơn.


  8. các bác nên tìm hiểu cách hoạt động của autoCad để tìm giải pháp thích hợp cho mình. Đôi khi thao tác chỉ căn tắt mở 1 số layeo hay lock 1 số layer ko cần thiết sẽ khiến tác vụ của bạn nhanh hơn nhiều. 

    Trong trường hợp của bạn chỉ cần lock các layer ko liên quan tới các field của bạn thì regen nó ko ảnh hưởng tốc độ nhiều. vì khi regen nó tính toán lại toàn bộ bản vẽ nên chậm gây ức chế. Nếu bạn quản lý tốt bản vẽ thì khi regen nó rất nhanh. Đây là cách mình khuyên các bạn nên dùng đễ dễ dàng trong các thao tác vẽ.

    • Like 1

  9. 56 phút trước, loststars đã nói:

    Hiện tại em đang làm việc với rất nhiều block ATT chứa Field nhưng sau mỗi lần thao tác lại phải REGEN hay UpDateField để Field cập nhật giá trị. Việc này rất ức chế khi bản vẽ nặng . Vậy liệu có cách nào để tự động cập nhật Field hoặc có lisp nào có thể update Field tự động k ạ?

    Thì bác cũng có câu trả lời rồi đó. Nếu bạn lười đánh thêm regen thì có lisp tự động regen cho bạn. Nhưng regen thì bạn ức chế khi bản vẽ nặng.

     


  10. 4 giờ trước, Duong Nhat Duy đã nói:

    Mình đang rất gấp, mình xin phép được nhờ các ae trong forum viết hoặc lên ý tưởng hộ mình vấn đề sau:

    Mình có các arc rời rạc, cần 1 lisp chuyển (hoặc tạo) arc đó thành 1 pline, trong đó có 2 đầu là 2 đoạn thẳng, ở giữa là arc, độ dài 2 đoạn thẳng cho mình chỉ định (ví dụ 1,2,3 gì đấy, lấy bằng hàm getPointatDist gì gì đó, để ra 1 cái điểm cách 2 mút chính xác 1 khoảng như đã chỉ định, bán kính của arc mới chính bằng arc cũ.

    Phiền các bạn giúp đỡ mình nhé, mình xin cảm ơn !

    Mình viết cho bạn 1 hàm convert nè theo kiểu cổ điển thôi

    sừ dụng như sau

    (cvarc  (car(entsel)) 5)

     

     

    
     

     (defun cvarc(en l / eg c r sa ea el p1 p2 bu)
      (setq eg (entget en))
      (mapcar '(lambda(a b) (set a (cdr(assoc b eg)))) '(c r sa ea) '(10 40 50 51))
      (setq el (last c)
        c (list (car c) (cadr c))
        p1 (polar c sa r)
        p2 (polar c ea r)
        bu (- ea sa)
        bu (/ (If (> bu 0) bu (+ pi pi bu)) 4)
        bu (/ (sin bu) (cos bu)))
        
      (entdel en)
      (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 0)

              (cons 38 el) ; Dat cao do
              (cons 10 (polar p1 (- sa (/ pi 2)) l))
              (cons 10 p1)
              (cons 42 bu)
              (cons 10 p2)
              (cons 10 (polar p2 (+ ea (/ pi 2)) l))

              (assoc 210 eg)))) ; Dat he truc toa do

    • Vote tăng 1

  11. Ý bác @Danh Cong chắc là như thế này

    (defun c:mtbl (/ s h ts ss)
      (setq s (getstring "\nNhap text:")
        h (getreal "\nNhap cao chu:")
        ts (getvar 'textstyle)
        ss (acet-ss-to-list (ssget '((0 . "LWPOLYLINE,LINE")))))
      (foreach e ss
          (setq o (vlax-ename->vla-object e))
          (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
                  (cons 7 ts)
                  (cons 10 (vlax-curve-getpointatdist o (/ (vla-get-length o) 2)))
                  (cons 40 h)
                  (cons 1 s)
                  '(71 . 5) '(90 . 3) '(63 . 256) '(45 . 1.5))))
      (redraw) (princ))

    Mình chèn text theo kiểu Mid+Cen cho khỏi mất c6ng tính.

    • Like 2
    • Vote giảm 1

  12. 7 giờ trước, Doan Van Ha đã nói:

    Test thử 1 hàm, nó xuất thừa:

    (kstrcase "Cad việt" T)
    Free lisp from cadviet.com.
     Don't sale"CAD VIỆT"

    Hi hi. Chỉ là đánh dấu cho vui thử thôi chứ không ảnh hưởng hàm lắm. Nó vẫn cho kết quả đúng mà.

     

    Mình vừa sửa lại không còn text thừa đó nữa. Chỉ hiện text khi load dll thôi

    Cả 2 bản cho Cad2007,và 2017

    Mình chỉ test dll ở bản 2017 trên cad 2017,2019 chạy tốt. Bạn nào sài Cad khác test dùm và comment cho mình biết với.

    Và có bổ sung thêm mấy hàm

    <LispFunction("delfile")> Public Function del1(st As ResultBuffer) As Object
            Try
                System.IO.File.Delete(st(0).value)
            Catch ex As Exception
                Return New TypedValue(5019)
                Exit Function
            End Try
            Return New TypedValue(5021)
        End Function
        <LispFunction("copyfile")> Public Function copy1(st As ResultBuffer) As Object
            Try
                System.IO.File.Copy(st(0).value, st(1).value, st(2).typecode <> 5019)
            Catch ex As Exception
                Return New TypedValue(5019)
                Exit Function
            End Try
            Return New TypedValue(5021)
        End Function
        <LispFunction("openfile")> Public Function openfile(st As ResultBuffer) As Object
            Try
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.Open(st(0).value, False)
            Catch ex As Exception
                Return New TypedValue(5019)
                Exit Function
            End Try
            Return New TypedValue(5021)
        End Function

    (delfile "d:\\baitap2\\e.dwg") : Xóa file name.

    (copyfile "d:\\baitap1\\d.dwg" "d:\\baitap2\\e.dwg" T) : Copy 1 file  trong do T/nil là ghi đè hay không. Vd (copyfile "d:\\baitap1\\d.dwg" "d:\\baitap2\\e.dwg" T)

    (openfile "d:\\baitap1\\d.dwg") Mở file autocad.

     

     

    Debug.rar


  13. MÌnh không chắc chắn 2file  trên là đủ chạy cho tất cả vesion cad vì file vd2.dll thì mình build trên net Framework 4.7 còn file dưới là .NET Framework 3.5.

    Các phiên bãn CAD khác nhau thì dùng .Net Framework Khác nhau. Tuy nhiên bản mới có thể chạy được trên bản cũ nhưng ngươc lại thì không.

    (2007,2008,2009 sài 2.0) (2010,2011,2012 sài 3.5) cùng sử dụng 2 file dll như 2007 là acmgd.dll và acdbmgd.dll

    (2013,2014 sài 4.0) (2015,2016 sài 4.5) (2017,2018,2019 sài 4.6,4.7)  thì sử dụng 3 file dll , 2 file trên và file accoremgd.dll

     

    Bác nào sài cad 2013 or 2014 có thể chép cho mình 3 file trên để mình build thử có chạy được trên Cad 2017/2019 không? Thanks.

    Và test dùm mình nó có thể chạy được file vd2.dll không?

    Vì mình thấy dòng báo lỗi của bác @Doan Van Ha báo do bản build runtime mới hơn bản hiện hành

    This assembly is built by a runtime newer than the currently loaded runtime and 
    cannot be loaded

     

     

    Thanks

     

     

     


  14. 43 phút trước, Doan Van Ha đã nói:

    Cad2007. 2 files gởi kèm:

    Lap_trinh_AutoCad_cho_Lisp_NgoKiet.zip

    (Chán nhất khi dùng Net là khi Cad thay đổi thì phải sửa)

    Ban thử file này nha.

     

    Còn dùng net kết hợp với lisp thì để kiễm tra cad vesion để load file dll thích hợp. Hình như từ 2013-2019 là sài chung. Cad 2012 trở về trước mới khác.

    vd3.zip

    • Like 1

  15. Viết Lisp cho AutoCad nó cũng có giới hạn nhất định. Một số hàm lisp không hỗ trợ tốt Tiếng Việt unicode. Nhất là các hàm visual

    Sau khi mày mò thừ visual studio để lập trình cho autoCad thì mình thấy cũng có thể viết vb.net để lập trình thêm 1 số hàm có thể sử dụng cho lisp.

    Mình viết ở đây một số hàm mình viết có thể sử dụng cho lisp.

    - Về cách đặt các thông số cho visual studio để lập trình được cho autoCad thì nhiều bài viết đã đề cập. Mình không nhắc lại ở đây nữa.

    1. Hàm kstrcase 

       <LispFunction("kstrcase")> Public Function kstrcase(ss As ResultBuffer) As Object
            If ss(1).Typecode = 5019 Then
                Return LCase(ss(0).value)
            Else
                Return UCase(ss(0).value)
            End If
        End Function

    Sừ dụng trong lisp : (kstrcase str code)

    srt: string, code là T or nil

    Nó trả về string là chữ hoa nếu Code là T và chữ thường nếu code là nil

    Ví dụ:  (kstrcase "Cad việt" T) -> "CAD VIỆT"

    Mình viết hàm này do nó hỗ trợ tốt unicode (Hàm chuẩn của lisp không hỗ trợ unicode)

    2.Hàm về file

    	<LispFunction("checkfileexist")> Public Function cfexist(st As ResultBuffer) As Object
            If My.Computer.FileSystem.FileExists(st(0).value) Then
                Return New TypedValue(5021)
            Else
                Return New TypedValue(5019)
            End If
        End Function
        <LispFunction("checkpathexist")> Public Function cpexist(st As ResultBuffer) As Object
            If My.Computer.FileSystem.DirectoryExists(st(0).value) Then
                Return New TypedValue(5021)
            Else
                Return New TypedValue(5019)
            End If
        End Function
        <LispFunction("Listfileinpath")> Public Function listfile(st As ResultBuffer) As Object
            If My.Computer.FileSystem.DirectoryExists(st(0).value) Then
                Dim rr As ResultBuffer = New ResultBuffer
                For Each s As String In System.IO.Directory.GetFiles(st(0).value)
                    rr.Add(New TypedValue(5005, s))
                Next
                Return rr
            Else
                Return New TypedValue(5019)
            End If
        End Function
        <LispFunction("getpath")> Public Function Getpath1(st As ResultBuffer) As Object
            Return System.IO.Path.GetDirectoryName(st(0).value)
        End Function
        <LispFunction("getfilename")> Public Function Getfilename1(st As ResultBuffer) As Object
            Return System.IO.Path.GetFileName(st(0).value)
        End Function
        <LispFunction("getextfile")> Public Function getextfile1(st As ResultBuffer) As Object
            Return System.IO.Path.GetExtension(st(0).value)
        End Function

    Ở đây mình có 6 hàm thường sử dụng. Hỗ trợ path và filename unicode

    (checkfileexist filename) : Kiểm tra file có tồn tại hay không?  -vd  (checkfileexist "D:\\bai tap\\abc.dwg")

    (checkpathexit path) : Kiểm tra đương dẫn có tồn tại hay không? 

    (listfilepath path): Trả về danh sách file trong đường dẫn

    (getpath filename): Trả về đường dẫn của filename

    (getfilename filename): Trả về tên file

    (getextfile filename): Trả về phần mở rộng của file

    3. Hàm về open/save file text

    	<LispFunction("opentext")> Public Function opentext(st As ResultBuffer) As Object
            Dim filen As String = st(0).value
            If My.Computer.FileSystem.FileExists(filen) Then
                filen = My.Computer.FileSystem.ReadAllText(filen)
                Dim s1() As String = System.Text.RegularExpressions.Regex.Split(filen, vbCrLf)
                Dim rr As ResultBuffer = New ResultBuffer
                For Each S2 In s1
                    rr.Add(New TypedValue(5005, S2))
                Next
                Return rr
            Else
                Return New TypedValue(5019)
            End If
        End Function
        <LispFunction("savetext")> Public Function savetext(st As ResultBuffer) As Object
            Dim ss() As TypedValue = st.AsArray
            Dim s1 As String = ""
            For i As Long = 1 To ss.Count - 1
                Select Case ss(i).TypeCode
                    Case 5001 To 5005
                        s1 = s1 & ss(i).Value & vbCrLf
                    Case 5002
                        s1 = s1 & ss(i).Value.x.ToString & "," & ss(i).Value.y.ToString & vbCrLf
                    Case 5009
                        s1 = s1 & ss(i).Value.x.ToString & "," & ss(i).Value.y.ToString & "," & ss(i).Value.z.ToString & vbCrLf
                End Select
            Next
            Try
                My.Computer.FileSystem.WriteAllText(st(0).value, s1, False)
            Catch ex As Exception
                Return New TypedValue(5019)
                Exit Function
            End Try
            Return New TypedValue(5021)
        End Function

    Ở đây có 2 hàm hỗ trợ tên file unicode

    (opentext filename) :  Đọc dữ liệu từ filename.  {Hỗ trợ sẵn file unicode, utf8, ansi

      Trả về kết quả là 1 list of string. Mỗi dòng là 1 string.

    (savetext filename value):  Ghi dữ liệu lên filename

     Value là 1 list string. Trả về kết quả là T nếu ghi thành công; nil thì thất bại.

    Hàm này ghi file theo chuẩn utf8.

     

     

    Với các ví dụ trên thì các bạn có thể viết riêng function lisp cho mình dùng. Mình up lên đây file dll cho các bạn viết lisp có thể sử dụng luôn.

    Cách sừ dụng

    Dùng lệnh Cad là netload chọn file vd2.dll hay dùng lệnh lisp : (command "_netload" "vd2.dll")

    Bạn có thể tham khảo thêm cách load file dll của autocad ( Thêm vào trust file)

     

    Trong vd2 mình có thêm 1 hàm getfileds Để chọn 1 hay nhiều file 1 lúc : Gần giống hàm getfield của lisp

    Cách sử dụng

     (getfileds "Chọn file cần" "D:\\Cadviet\\dtd.txt" "File văn bản |*.txt;*.cvs|Tất cả file |*.*" 3)

    "Chọn file cần" : Tên dialog chọn file

    "D:\\Cadviet\\dtd.txt" : Tên file mặc định

    "File văn bản |*.txt;*.cvs|Tất cả file |*.*" : Các kiểu bộ lọc - Cấu trúc theo chuẩn của window

    3: code bit 1:  Multiselect  bit 2: Check file exist.

     

    Có thắc mắc gì thì cứ hỏi ở đây. Mình sẽ trả lời.

    Nếu sừ dụng được thì cho mình 1 like để mình biết.

     

    Thanks. Chúc mọi người vui vẻ.

     

     

     

     

    vd2.rar

    • Like 1
×