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

gia_bach

CADViet Team
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    1.619

  • Đã tham gia

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

  • Ngày trúng

    122

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

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

    CPU Core-i5 10400 RAM: 16GB

     - AutoCAD 2016: 3.3 s

     - AutoCAD 2022: 2.0 s

     - BricsCAD V21: 1.5 s

     

    @cuongtk2 : thử thay thế (ACET-SS-TO-LIST  bằng (repeat (setq i (sslength ss))      (setq ent (ssname ss (setq i (1- I))))

    thì CAD 2016 có cải thiện tốc độ (2.5 giây), nhưng tốc độ trên CAD 2022 gần như không thay đổi.

    • Like 1

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

    1 giờ} trướ}c, Leeboow đã nói:

    Đúng là không có ý nghĩa thực tế nhiều. tuy nhiên khách hàng là thượng đế nên mình chỉ chiều theo ý họ thôi bác. hihi.

    Chứ em cũng thấy nó vô nghĩa ^^

    Nó liên quan đến "CAD standard".

    22 phút trước, cuongtk2 đã nói:

    Với autolisp , bạn không thể làm ở hàng loạt bản vẽ một cách im lìm. Phải dùng .NET

    ObjectDBX / VisualLISP xử được.

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

    Hồi mới vào nghề, cứ block Atts là nổ (explode) ra, rồi sử dụng lisp cộng text mà làm, cứ thế cũng kiếm được chút cơm các bác ạ !

    Giờ chắc lisp này đáp ứng đc y/cầu của thớt: 

    (defun c:PhanLoaiThep (/ lst ss  )
  ;;  By : Gia_Bach, www.CadViet.com
  (defun Get_TrongLuong (ent / dk tl)  ; DK TL
    (foreach att (vlax-invoke (vlax-Ename->Vla-Object ent) 'GetAttributes)
      (cond
	( (= "DK" (vla-get-TagString Att) ) (setq dk (vla-get-TextString Att)))
	( (= "TL" (vla-get-TagString Att) ) (setq tl (vla-get-TextString Att)))
	( t nil) ) )
    (if (and dk tl)
      (progn
	(if(= (substr dk 1 1) "`") (setq dk (substr dk 2)))
	(if(= (substr dk 1 3) "%%c") (setq dk (substr dk 4)))
	(cons dk (distof tl))) ))
  
  (if (setq ss (ssget(list (cons 0 "INSERT")(cons 66 1)(cons 2 "NGHIA_THKE"))))
    (progn
      (setq i -1)
      (while (setq ent (ssname ss (setq i (1+ i))))
	(if (setq DkTl (Get_TrongLuong ent) )
	  (progn
	    (setq dk (car dktl) tl (cdr dktl))
	    (if (setq asoc (assoc dk lst))
	      (setq lst (subst (cons dk (+ tl (cdr asoc)) ) asoc lst))
	      (setq lst (append lst (list dktl)) )) )	))
      ; phan loai Thep dk <=10 =?, thep dk <=18 = ?, va thep dk>18=?
      (setq dk10 0 dk18 0 dk50 0)
      (foreach dktl lst
	(setq dk (distof (car dktl)))
	(cond
	  ((<= dk 10) (setq dk10 (+ dk10 (cdr dktl))))
	  ((<= dk 18) (setq dk18 (+ dk18 (cdr dktl))))
	  (t (setq dk50 (+ dk50 (cdr dktl))) )))
      (if (> dk10 0) (princ (strcat "\nD/kinh <=10, TL: "(rtos dk10)) ) )
      (if (> dk18 0) (princ (strcat "\nD/kinh <=18, TL: "(rtos dk18)) ) )
      (if (> dk50 0) (princ (strcat "\nD/kinh  >18, TL: "(rtos dk50)) ) )
    ) )  
  (princ))

     

    • Like 1
    • Vote tăng 2

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

    Đây là một cách: 

    (defun c:AI ()
  (PROMPT"\nSelect texts to change to -ARIAL")
  (if (and
	(setq ss (ssget))
	(CreateTextStyle "-ARIAL" "arial.ttf" 0 1) )
    (progn      
      ;(setq ss (ssget))
      ;(command "-style" "-ARIAL" "Arial" "0" "1" "0" "" "")
      (setq c 0)
      (if ss (setq e (ssname ss c)))
      (while e
	(setq e (entget e))
	(if (= (cdr (assoc 0 e)) "TEXT")
	  (progn
	    (setq txt "-ARIAL")
	    (setq e (subst (cons 7 txt) (assoc 7 e) e))
	    (entmod e)
	    ))
	(setq c (1+ c))
	(setq e (ssname ss c))
	)))    
    (Princ))

     

    • Like 1
    • Vote tăng 1

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

    Vào lúc 29/8/2023 tại 14:45, united đã nói:

    Em tạo style bằng:

        (command "-style" "-ARIAL" "Arial" "0" "1" "0" "" "")

    Kết quả thu được là stype -ARIAL với Font Name "Arial CYR"

    Anh cho em hỏi làm sao để thu được Font Name "Arial"?

    Em cảm ơn anh!

    Thử chạy lisp này:

    (CreateTextStyle "-ARIAL" "arial.ttf" 0 0.9) 

    (defun CreateTextStyle (StyleName Font Height WidthFactor  / doc txtStyles Obj Font_Path TypeFace Bold Italic charSet PitchandFamily)
  (vl-load-com) 
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        txtStyles (vla-get-textstyles doc)  )
  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list txtStyles StyleName)))
    (setq Obj (vla-add txtStyles StyleName))
    (setq Obj (vla-Item txtStyles StyleName)))
    
  (if Obj
    (progn
      (if (= (strcase (vl-filename-extension Font)) (strcase ".ttf"))
        (if (not (setq Font_Path (findfile (strcat (getenv "WINDIR") "\\fonts\\" Font))))
	  (setq Font_Path (findfile Font))
        )
      )
      (if Font_Path
	(progn
	  (setq DestinationTypeFace (vl-filename-base Font))
	  (vla-GetFont Obj 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)
	  (vla-put-fontfile Obj Font_Path)
	  (vla-SetFont Obj DestinationTypeFace Bold Italic charSet PitchandFamily)
	  (vla-put-height Obj Height)
	  (vla-put-width Obj WidthFactor) )
        (progn
          (alert "Couldn't find font path, exiting!")
          ;(exit)
        )
      )      
    )
  )
  Obj
)

     

    • Like 1

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

    Sử dụng hàm Quick UnFormat của chú Lee nè. 

    (defun c:unformat ( / *error* enx idx rgx sel str )
    (cond
        (   (or (vl-catch-all-error-p (setq rgx (vl-catch-all-apply 'vlax-get-or-create-object '("vbscript.regexp"))))
                (null rgx)
            )
            (princ "\nUnable to interface with RegExp object.")
        )
        (   (setq sel (ssget "_:L" '((0 . "MTEXT"))))
            (repeat (setq idx (sslength sel))
                (setq enx (entget (ssname sel (setq idx (1- idx))))
                      str (assoc 1 enx)
                )
                (entmod (subst (cons 1 (LM:quickunformat rgx (cdr str))) str enx))
            )
        )
    )
    (princ)
)

;; Quick Unformat  -  Lee Mac
;; Returns a string with all MText formatting codes removed.
;; rgx - [vla] Regular Expressions (RegExp) Object
;; str - [str] String to process

(defun LM:quickunformat ( rgx str )
    (if
        (null
            (vl-catch-all-error-p
                (setq str
                    (vl-catch-all-apply
                       '(lambda nil
                            (vlax-put-property rgx 'global     actrue)
                            (vlax-put-property rgx 'multiline  actrue)
                            (vlax-put-property rgx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"     . "\\\\\\\\")
                                    (" "        . "\\\\P|\\n|\\t")
                                    ("$1"       . "\\\\(\\\\[ACcFfHKkLlOopQTW])|\\\\[ACcFfHKkLlOopQTW][^\\\\;]*;|\\\\[ACcFfKkHLlOopQTW]")
                                    ("$1$2/$3"  . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"     . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"       . "[\\\\]({)|{")
                                    ("\\$1$2$3" . "(\\\\[ACcFfHKkLlOoPpQSTW])|({)|(})")
                                    ("\\\\"     . "\032")
                                )
                                (vlax-put-property rgx 'pattern (cdr pair))
                                (setq str (vlax-invoke rgx 'replace str (car pair)))
                            )
                        )
                    )
                )
            )
        )
        str
    )
)

(vl-load-com)

     

    • Like 1

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

    Đúng là giá của AutoCAD quá cao, để giảm chi phí một số cty (bao gồm cả cty Viet Nam) chuyển qua sử dụng các phiên bản CAD khác như: BricsCAD, GstarCAD, ZWCAD, IntelliCAD, ...
    Các bản CAD này đáp ứng được các yêu cầu cơ bản của 1 phần mềm vẽ kỹ thuật và có thể chạy trên các máy tính cấu hình thấp. 
    Tuy nhiên với các dự án lớn hay 3D (file từ vài chục đến trên 100 Mb), thì AutoCAD chạy vẫn mượt hơn (một phần do yêu cầu cấu hình máy tính cao).

     

    Về mặt lập trình, các CAD này cũng hỗ trợ các ngôn ngữ như LISP, VBA, .NET ...
    Đặc biệt với .NET, chúng ta có thể tái sử dụng code viết cho AutoCAD để compile cho các CAD này.

    https://www.dropbox.com/s/e3l7k9tcwx11a3v/MultiVersion.mp4

     

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

    9 giờ trước, quyenpv đã nói:

    Có thể tự chọn điểm vẽ và hướng vẽ không anh

    update: 

    - chọn điểm vẽ.

    - hướng vẽ: có thể sử dụng hàm GetNumberFromUser 

     hoặc yêu cầu user pick thêm 1 điểm và tính góc qua 2 điểm này.

     

    code nhiều, thử nhiều lần sẽ lên tay thôi.

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

    Góc tính theo radian: 

        Public Function PolarPoint(ByVal basePt As Point2d, ByVal angle As Double, ByVal distance As Double) As Point2d
        Dim x As Double = basePt(0) + distance * Math.Cos(angle)
        Dim y As Double = basePt(1) + distance * Math.Sin(angle)
        Dim point As Point2d = New Point2d(x, y)
        Return point
    End Function

    <CommandMethod("DrawLines2")>
    Public Sub DrawPLines()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        ' Lấy số lượng đường cần vẽ từ người dùng
        Dim numLines As Integer = 7 ' GetNumberFromUser("Nhập số lượng đường (từ 1 đến 12): ", 1, 12)

        ' Lấy khoảng cách giữa các đường từ người dùng
        Dim distance As Double = 12 ' GetNumberFromUser("Nhập khoảng cách giữa các đường (số nhỏ nhất là 3): ", 3, Double.MaxValue)

        ' Danh sách mã màu cho các đường
        Dim colors() As Integer = {160, 30, 94, 15, 253, 255, 10, 250, 50, 202, 220, 130}

        ' Kiểm tra nếu Layer "SODODAUNOI" chưa tồn tại, tạo mới
        'If Not LayerExists("SODODAUNOI") Then
        '    CreateLayer("SODODAUNOI")
        'End If

        Dim length As Double = distance * 5
        Dim angle As Double = System.Math.PI / 3

        Dim insertPt As Point3d

        Dim ppr As PromptPointResult = ed.GetPoint("\nInsertion point: ")
        If ppr.Status <> PromptStatus.OK Then Return
        insertPt = ppr.Value

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

            ' Vẽ đường thứ nhất
            Dim startPoint As New Point2d(insertPt.X, insertPt.Y)
            Dim endPoint As New Point2d()
            endPoint = PolarPoint(startPoint, angle, length)

            Dim pLine As New Polyline()
            pLine.AddVertexAt(0, New Point2d(startPoint.X, startPoint.Y), 0, 0, 0)
            pLine.AddVertexAt(1, New Point2d(endPoint.X, endPoint.Y), 0, 0, 0)

            pLine.ColorIndex = colors(0)
            'pLine.Layer = "SODODAUNOI"
            btr.AppendEntity(pLine)
            trans.AddNewlyCreatedDBObject(pLine, True)

            ' Vẽ các đường tiếp theo
            For i As Integer = 1 To numLines - 1
                startPoint = PolarPoint(startPoint, angle - System.Math.PI / 2, distance)
                endPoint = PolarPoint(endPoint, angle - System.Math.PI / 2, distance)
                pLine = New Polyline()
                pLine.AddVertexAt(0, startPoint, 0, 0, 0)
                pLine.AddVertexAt(1, endPoint, 0, 0, 0)
                pLine.ColorIndex = colors(i Mod colors.Length)
                'pLine.Layer = "SODODAUNOI"
                btr.AppendEntity(pLine)
                trans.AddNewlyCreatedDBObject(pLine, True)

                ' Cập nhật điểm khởi đầu cho đường tiếp theo
                'startPoint = New Point2d(startPoint.X, startPoint.Y + distance)
                'endPoint = New Point2d(endPoint.X, endPoint.Y + distance)
            Next

            trans.Commit()
        End Using

        ed.WriteMessage("Đã vẽ xong các đường PLINE.")
    End Sub

     

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

    Bạn tham khảo code :  

        <CommandMethod("DrawLines2")>
    Public Sub DrawPLines()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        ' Lấy số lượng đường cần vẽ từ người dùng
        Dim numLines As Integer = 7 ' GetNumberFromUser("Nhập số lượng đường (từ 1 đến 12): ", 1, 12)

        ' Lấy khoảng cách giữa các đường từ người dùng
        Dim distance As Double = 12 ' GetNumberFromUser("Nhập khoảng cách giữa các đường (số nhỏ nhất là 3): ", 3, Double.MaxValue)

        ' Danh sách mã màu cho các đường
        Dim colors() As Integer = {160, 30, 94, 15, 253, 255, 10, 250, 50, 202, 220, 130}

        '' Kiểm tra nếu Layer "SODODAUNOI" chưa tồn tại, tạo mới
        'If Not LayerExists("SODODAUNOI") Then
        '    CreateLayer("SODODAUNOI")
        'End If

        Dim length As Double = distance * 5

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

            ' Vẽ đường thứ nhất
            Dim startPoint As New Point2d(0, 0)
            Dim endPoint As New Point2d(length, 0)
            Dim pLine As New Polyline()
            pLine.AddVertexAt(0, New Point2d(startPoint.X, startPoint.Y), 0, 0, 0)
            pLine.AddVertexAt(1, New Point2d(endPoint.X, endPoint.Y), 0, 0, 0)

            pLine.ColorIndex = colors(0)
            'pLine.Layer = "SODODAUNOI"
            btr.AppendEntity(pLine)
            trans.AddNewlyCreatedDBObject(pLine, True)

            ' Vẽ các đường tiếp theo
            For i As Integer = 1 To numLines - 1
                startPoint = New Point2d(startPoint.X, startPoint.Y + distance)
                endPoint = New Point2d(endPoint.X, endPoint.Y + distance)
                pLine = New Polyline()
                pLine.AddVertexAt(0, startPoint, 0, 0, 0)
                pLine.AddVertexAt(1, endPoint, 0, 0, 0)
                pLine.ColorIndex = colors(i Mod colors.Length)
                'pLine.Layer = "SODODAUNOI"
                btr.AppendEntity(pLine)
                trans.AddNewlyCreatedDBObject(pLine, True)

                ' Cập nhật điểm khởi đầu cho đường tiếp theo
                'startPoint = New Point2d(startPoint.X, startPoint.Y + distance)
                'endPoint = New Point2d(endPoint.X, endPoint.Y + distance)
            Next

            trans.Commit()
        End Using

        ed.WriteMessage("Đã vẽ xong các đường PLINE.")
    End Sub

     

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

    54 phút trước, cuong26 đã nói:

    trong autocad mình không sử dụng được phím shift, trước đây vẫn bình thường nhưng hôm nay lại không sử dụng được nữa. đã thử gỡ đi và cài đặt lại nhưng vẫn không dùng được, bị lỗi cả 2 phím. các phần mềm khác thì vẫn sử dụng phím shift bình thường. chỉ riêng trong các ứng dụng của autodesk thì lại không sử dụng được. ai có cách khác phục lỗi này không ạ.

    Cái này hình như lỗi khi update lên win10.

    tham khảo:

    https://forums.autodesk.com/t5/autocad-forum/ortho-shift-key-not-working-correctly/td-p/8163935

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

    Cám ơn bác đã gợi ý.

    .NET có thể thay đổi độ phân giải màn hình.

    Tuy nhiên khi ứng dụng vào thực tế thì không khả thi, nó ảnh hưởng rất nhiều đến trải nghiệm của người dùng.

    (sự thay đổi của kích thước màn hình quá lớn, từ 4K => full HD và ngược lại).

     

    @7o7: hình như trước đây bác là đồng nghiệp với tôi ?!

     

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

    Chào anh em CadViet,


    Một người quen có nhờ tôi viết 1 tool in ra file PDF, mọi việc xuôn sẻ như nó vốn phải thế.
    Tuy nhiên mới đây tôi có nhận được "than phiền" về hộp thoại, nó hiển thị không chính xác (hình bên trái), qua tìm hiểu thì nó chỉ xảy ra khi chạy trên màn hình có độ phân giải 4K (3840x2160).

     

    Cho hỏi, có anh em nào đã gặp trường hợp này chưa? (khi sử dụng CAD với màn hình 4K)
    Nếu có, cách khắc phục thế nào?

     

    Cám ơn anh em đã đọc tin.

     

    PS: đính kèm dll, tên lệnh: HopThoai4K. 

    Download here: HopThoai4K.zip

     

    Dialog Monitor_4K.png

     

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

    Bạn thay đổi bán kính theo thực tế nhé.

     

    (defun CK:LineWeldF (dd)
       (if (not (tblsearch "layer" "WELDF"))
          (command "._layer" "n" "WELDF" "c" "Magenta" "WELDF" "l" "continuous" "WELDF" "")
          (command "._layer" "c" "Magenta" "WELDF" "")
       )
       (setvar "clayer" "WELDF")
       (setq d1    (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m \U+0111\U+1EA7u: ")
             d2    (getpoint d1 "\nCh\U+1ECDn \U+0111i\U+1EC3m cu\U+1ED1i: ")
       )
      (setq rad 100) ; ban kinh duong tron
      (setq ang (angle d1 d2)
        d3 (polar d1 ang (- (distance d1 d2) rad)))
       ;(command "LINE" d1 d2 d2 \e)
      (command "LINE" d1 d3 "")
    )

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

    15 phút trước, limfx đã nói:

    Phương thức AddDimArc Method:

    RetVal = object.AddDimArc(ArcCenter, FirstEndPoint, SecondEndPoint, ArcPoint)

    Mình test thử:

    (defun c:test()
    (vl-load-com)
    (setq arc (car (entsel)))
    (setq arcobj (vlax-ename->vla-object arc))
    (setq sp (vlax-curve-getstartpoint arcobj))
    (setq ep (vlax-curve-getendpoint arcobj))
    (setq cpt (vlax-get arcobj 'Center))
    (setq p3 (getpoint cpt))
    (vlax-invoke arcobj 'AddDimArc cpt sp ep p3)
    );end

    Xuất hiện lỗi: error: ActiveX Server returned the error: unknown name: "ADDDIMARC"?

    Bạn dùng thử lisp này: 

    (defun c:dima (/ doc spc ss cnt ent el spt ept mpt)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        spc (vlax-get-property doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
  )
  (princ "\nSelect line-arc ")  
  (if (setq ss (ssget "_:L" '((0 . "LINE,ARC"))))
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  el (entget ent)
                  spt (vlax-curve-getstartpoint ent)
                  ept (vlax-curve-getendpoint ent)
                  mpt (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent ept) 2.0))
            );end_setq
            (cond ( (= (cdr (assoc 0 el)) "LINE") (vlax-invoke spc 'adddimaligned spt ept mpt))
                  ( (= (cdr (assoc 0 el)) "ARC") (vlax-invoke spc 'adddimarc (cdr (assoc 10 el)) spt ept mpt))
            );end_cond
            
          );end_repeat
        )
  (princ )
)

     

    • Like 1

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

    Bạn thử lisp này: 

    (defun C:eDimLocation (/ ss e ds goc pt13 pt14 pt10)
  ; @Gia_Bach
  ; edit dimension line location
  (defun dxf(id entdata) (cdr (assoc id entdata)) )
  
  (if (setq ss (ssget "_:L"'((0 . "DIMENSION")  )) )
    (progn
      (or *kc* (setq *kc* 100))
      (initget 2)
      (setq khcach (getint (strcat"\nNhap khoang cach <" (rtos *kc*) ">:"))	)
      (if khcach (setq *kc* khcach) (setq khcach *kc*))
      
      (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(setq ds (entget e)
	      pt10 (dxf 10 ds)
	      pt13 (dxf 13 ds)
	      pt14 (dxf 14 ds)	      )
	(if (equal pt10 pt14 0.001)
	  (setq goc (+ (/ pi 2)(angle pt13 pt14)))
	  (setq goc (angle pt10 pt14)) )
	(setq ds (subst (cons 10 (polar pt10 goc *kc*)) (assoc 10 ds) ds))
	(entmod ds)	) ) )  
  (princ)  )

     

    • Like 1

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

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

    Kiểm tra thử, chiều dài curve là 297.34 đơn vị vẽ thì trong khoảng 5 đơn vị vẽ cuối cùng là không thể lấy góc tiếp tuyến. Một khoảng cách quá lớn!!!
    (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) = 297.34

    (setq pt (vlax-curve-getpointatdist ent 292.34)) = (3820.83 402.536 0.0)

    (vlax-curve-getFirstDeriv ent (vlax-curve-getParamAtPoint ent pt)) >> error: bad argument type: numberp: nil

    Ứng với bản vẽ bác đính kèm, param của điểm cuối là 294.03769646133196, tại giá trị này thì Cad bị lỗi.

    Nhưng nếu làm tròn 3 số lẻ (e-3) 294.038 thì có thể lấy tiếp tuyến được.

    Không biết lỗi này có phụ thuộc phiên bản CAD hay không?!  Tôi dùng CAD 2016. 

    (defun C:HA()
 (setq ent (car (entsel "\nPick entity: ")))

; (setq endParam (vlax-curve-getendParam ent)) ; endParam = 294.03769646133196
  (setq endParam 294.038)
  (setq pt (vlax-curve-getPointAtParam ent endparam))
  (setq goc (angle '(0 0 0) (vlax-curve-getFirstDeriv ent endparam)))
  (entmake (list (cons 0 "LINE") '(100 . "AcDbEntity") (cons 10 pt) (cons 11 (polar pt (+ goc (/ pi 2)) 100.0))))
  ; (setq endParam 294.0376) error
  )

     

    • Like 1
×