Recent Posts

Pages: [1] 2 3 ... 10
1
AutoLISP (Vanilla / Visual) / Re: Automatic Nesting for lisp?
« Last post by well20152016 on Today at 10:52:26 am »
How many kinds of large rectangular size by n small rectangle?

Result:((200 10) (180 10) (160 10) (140 10) (120 10) (100 20) (80 20) (60 30) (40 50)
(20 100))

Code - Auto/Visual Lisp: [Select]
  1. (defun c:tt()
  2.  (setq w 20 l 10 n 10)
  3.  (setq p (getpoint"\n insertion point") b p i 1 lst nil)
  4.  (repeat n
  5.    (repeat i
  6.       (repeat (fix(/ n i)) (LM:ENTMAKE-LWPOLYLINE (4boxs b w l)) (setq b (polar b 0 l)))
  7.        (setq b (list (car p) (+ w (cadr b)))))
  8.    (setq lst (cons(list (* i w) (* (fix(/ n i)) l)) lst) i (1+ i))
  9.    (setq b (list (car p) (+ (cadr b) 4)))
  10.    )
  11. (princ "\n")
  12. (princ lst)
  13.  
  14. (defun 4boxs (p w l)
  15.  (list p  (polar p (* 0.5 pi) w) (polar (polar p 0 l) (* 0.5 pi) w)  (polar p 0 l))
  16. )
  17.  
  18. (defun LM:ENTMAKE-LWPOLYLINE (lst  / p)
  19.              (list (cons 0 "LWPOLYLINE")
  20.    (cons 100 "AcDbEntity")
  21.                    (cons 100 "AcDbPolyline")
  22.    (cons 90 (length lst) )
  23.    (cons 70 1 )
  24.    (cons 62 2 )
  25.              )
  26.              (mapcar(function (lambda (p) (cons 10 p)))lst)
  27. )))    
  28.  
2
.NET / How can I Transform Cordinate System
« Last post by sigster on Today at 09:36:07 am »

Hi

I use this code to Transform Cordinate System

How can I Transform all object in open drawing just loop through all object and Transform

Code: [Select]
   <CommandMethod("CONVERT_TO")> _
        Sub Convert_to()

            Dim path_File As String = OpenFile()

            If (path_File = "") Then
                Exit Sub
            Else

                Dim editor As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
                Dim Attach_file As String = path_File
                Dim Project_M As ProjectModel = HostMapApplicationServices.Application.ActiveProject
                Project_M.Options.MarkObjectsForEditingWithoutPrompting = True

                Dim keywordOptions = New PromptKeywordOptions(vbLf & "Select [LL84/ISN93]: ", "LL84 ISN93")

                keywordOptions.Keywords.[Default] = "ISN93"

                Dim keywordResult As PromptResult = editor.GetKeywords(keywordOptions)


                If keywordResult.Status = PromptStatus.OK Then
                    If keywordResult.StringResult = "LL84" Then
                        Project_M.Projection = "LL84"
                    End If
                ElseIf keywordResult.StringResult = "ISN93" Then
                    Project_M.Projection = "ISN93.IcelandGrid"
                End If


                Dim dwgset As DrawingSet = Project_M.DrawingSet
                dwgset.AttachDrawing(Attach_file)
                Dim Query_Model As QueryModel = Project_M.CurQuery
                Query_Model.Mode = QueryType.QueryDraw
                Query_Model.Clear()

                Dim qryRoot As QueryBranch = QueryBranch.Create()

                Dim locationcondition As New LocationCondition()
                locationcondition.LocationType = Autodesk.Gis.Map.Constants.LocationType.LocationCrossing
                locationcondition.Boundary = AllBoundary.Create()
                qryRoot.AppendOperand(locationcondition)
                Query_Model.Define(qryRoot)

                Dim queriedobjids As ObjectIdCollection = Query_Model.Execute(dwgset)

                Query_Model.Clear()
                dwgset.DetachDrawing(Attach_file)


                Dim acadApp As Object = Autodesk.AutoCAD.ApplicationServices.Application.AcadApplication
                acadApp.ZoomExtents()

            End If
        End Sub

        Public Function OpenFile() As String

            Dim strFileName = ""
            Dim fileDialogBox As New OpenFileDialog()
            fileDialogBox.Filter = "Autocad Drawing|*.dwg"

            fileDialogBox.FilterIndex = 3
            fileDialogBox.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Personal)

            If (fileDialogBox.ShowDialog() = DialogResult.OK) Then
                strFileName = fileDialogBox.FileName
            End If
            Return strFileName

        End Function
3
AutoLISP (Vanilla / Visual) / Re: how to calculate the correct nor?
« Last post by ssdd on December 03, 2016, 07:13:03 pm »
thank  Marko !
thank  roy_043!
4
AutoLISP (Vanilla / Visual) / Re: DST >> XML, XML >> DST
« Last post by MP on December 03, 2016, 06:53:26 pm »
Thanks for the enthusiastic thanks. :)

I've tried it on 2 different machines, AutoCAD 2011 and 2012 >> Worked on both.
5
AutoLISP (Vanilla / Visual) / Re: DST >> XML, XML >> DST
« Last post by steve.carson on December 03, 2016, 05:15:38 pm »
Can't wait to try this out Monday!

Many thanks!
6
AutoLISP (Vanilla / Visual) / Re: how to calculate the correct nor?
« Last post by roy_043 on December 03, 2016, 04:35:39 pm »
The problem is related to the Arbitrary Axis Algorithm. The best approach IMO is to create the new polyline in the WCS and then use a transformation matrix:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:tt ( / acDoc n norNew norObj obj ss)
  2.  (vla-endundomark acDoc)
  3.  (if (setq ss (ssget '((0 . "SPLINE,LINE,ARC,LWPOLYLINE"))))
  4.    (repeat (setq n (sslength ss))
  5.      (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
  6.      (setq norObj (vlax-get obj 'normal))
  7.      (setq norNew (KGA_Geom_VectorUnit (vlax-curve-getfirstderiv obj (vlax-curve-getstartparam obj))))
  8.      (vla-transformby
  9.        (VL-AddLWPolyline
  10.          (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
  11.          '((5.0 20.0 0.0) (5.0 -20.0 0.0) (-5.0 -20.0 0.0) (-5.0 20.0 0.0))
  12.          :vlax-true
  13.        )
  14.        (vlax-tmatrix
  15.          (KGA_Geom_MatrixMake
  16.            (KGA_Geom_VectorCrossProduct norNew norObj) ; X vector.
  17.            norObj                                      ; Y vector.
  18.            norNew                                      ; Z vector.
  19.            (vlax-curve-getstartpoint obj)              ; Origin.
  20.          )
  21.        )
  22.      )
  23.    )
  24.  )
  25.  (vla-endundomark acDoc)
  26.  (princ)
  27. )
  28.  
  29. (defun VL-AddLWPolyline (Space Pts Closed / obj)
  30.  (setq obj
  31.      Space
  32.      (vlax-make-variant
  33.        (vlax-safearray-fill
  34.          (vlax-make-safearray vlax-vbdouble (cons 0 (1- (* 2 (length Pts)))))
  35.          (apply
  36.            (quote append)
  37.            (mapcar
  38.              (function
  39.                (lambda (%) (list (car %) (cadr %)))
  40.              )
  41.              Pts
  42.            )
  43.          )
  44.        )
  45.      )
  46.    )
  47.  )
  48.  (vla-put-normal obj (vlax-3d-point '(0.0 0.0 1.0))) ; Normal of the WCS.
  49.  (if Closed (vla-put-closed obj Closed))
  50.  obj
  51. )
  52.  
  53. (defun KGA_Geom_MatrixMake (xVec yVec zVec org)
  54.  (append
  55.    (mapcar 'list xVec yVec zVec org)
  56.    '((0.0 0.0 0.0 1.0))
  57.  )
  58. )
  59.  
  60. ; Yes, I know! There are nicer looking cross product functions out there... But are they faster?
  61. (defun KGA_Geom_VectorCrossProduct (vec1 vec2)
  62.  (list
  63.    (float (- (* (cadr vec1) (caddr vec2)) (* (caddr vec1) (cadr vec2))))
  64.    (float (- (* (caddr vec1) (car vec2)) (* (car vec1) (caddr vec2))))
  65.    (float (- (* (car vec1) (cadr vec2)) (* (cadr vec1) (car vec2))))
  66.  )
  67. )
  68.  
  69. (defun KGA_Geom_VectorScale (vec scl)
  70.  (mapcar '(lambda (a) (* a (float scl))) vec)
  71. )
  72.  
  73. (defun KGA_Geom_VectorUnit (vec / mag)
  74.  (if (/= 0.0 (setq mag (distance '(0.0 0.0 0.0) vec)))
  75.    (KGA_Geom_VectorScale vec (/ 1.0 mag))
  76.  )
  77. )
7
AutoLISP (Vanilla / Visual) / Re: how to calculate the correct nor?
« Last post by ribarm on December 03, 2016, 03:17:36 pm »
Try this (untested) :

Code: [Select]
(setq nor
  (mapcar '/
    (vlax-curve-getFirstDeriv en (vlax-curve-getStartParam en))
    (list
      (distance '(0 0 0) (vlax-curve-getFirstDeriv en (vlax-curve-getStartParam en)))
      (distance '(0 0 0) (vlax-curve-getFirstDeriv en (vlax-curve-getStartParam en)))
      (distance '(0 0 0) (vlax-curve-getFirstDeriv en (vlax-curve-getStartParam en)))
    )
  )
)
8
AutoLISP (Vanilla / Visual) / Re: sorting LINE entities by end points
« Last post by ribarm on December 03, 2016, 12:05:39 pm »
Well as you can see from the link from previous post, I did find alternative solution for the task OP there asked... And when I said that I need every possible optimization of code to be faster I meant every small thing even detail like switching from Vanilla to Visual... You may find it silly, but (vlax-curve-*) function is ab 10x faster than my previous used with (entget)... I've also changed (cond) function as last check is unnecessary - also switched positions inside (cond) as by my opinion it checks less things with smaller number of (vl-some) statements and that means that it's faster... So here is it till now from me... If someone thinks ab something I've missed, please jump in...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:sortlinesbyendpts ( / ss elst el1 el2 el3 ssel1 ssel2 ssel3 )
  2.  
  3.  
  4.  (setq ss (ssget '((0 . "LINE"))))
  5.  (setq elst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  6.  (foreach e elst
  7.    (cond
  8.      ( (and
  9.          (not
  10.            (vl-some '(lambda ( x )
  11.              (or
  12.                (equal (vlax-curve-getstartpoint e) (vlax-curve-getstartpoint x) 1e-6)
  13.                (equal (vlax-curve-getstartpoint e) (vlax-curve-getendpoint x) 1e-6)
  14.              )) (vl-remove e elst)
  15.            )
  16.          )
  17.          (not
  18.            (vl-some '(lambda ( x )
  19.              (or
  20.                (equal (vlax-curve-getendpoint e) (vlax-curve-getstartpoint x) 1e-6)
  21.                (equal (vlax-curve-getendpoint e) (vlax-curve-getendpoint x) 1e-6)
  22.              )) (vl-remove e elst)
  23.            )
  24.          )
  25.        )
  26.        (setq el1 (cons e el1))
  27.      )
  28.      ( (and
  29.          (vl-some '(lambda ( x )
  30.            (or
  31.              (equal (vlax-curve-getstartpoint e) (vlax-curve-getstartpoint x) 1e-6)
  32.              (equal (vlax-curve-getstartpoint e) (vlax-curve-getendpoint x) 1e-6)
  33.            )) (vl-remove e elst)
  34.          )
  35.          (vl-some '(lambda ( x )
  36.            (or
  37.              (equal (vlax-curve-getendpoint e) (vlax-curve-getstartpoint x) 1e-6)
  38.              (equal (vlax-curve-getendpoint e) (vlax-curve-getendpoint x) 1e-6)
  39.            )) (vl-remove e elst)
  40.          )
  41.        )
  42.        (setq el3 (cons e el3))
  43.      )
  44.      ( t
  45.        ;|
  46.         (or
  47.           (and
  48.             (vl-some '(lambda ( x )
  49.               (or
  50.                 (equal (vlax-curve-getstartpoint e) (vlax-curve-getstartpoint x) 1e-6)
  51.                 (equal (vlax-curve-getstartpoint e) (vlax-curve-getendpoint x) 1e-6)
  52.               )
  53.             ) (vl-remove e elst))
  54.             (not
  55.               (vl-some '(lambda ( x )
  56.                 (or
  57.                   (equal (vlax-curve-getendpoint e) (vlax-curve-getstartpoint x) 1e-6)
  58.                   (equal (vlax-curve-getendpoint e) (vlax-curve-getendpoint x) 1e-6)
  59.                 )
  60.               ) (vl-remove e elst))
  61.             )
  62.           )
  63.           (and
  64.             (not
  65.               (vl-some '(lambda ( x )
  66.                 (or
  67.                   (equal (vlax-curve-getstartpoint e) (vlax-curve-getstartpoint x) 1e-6)
  68.                   (equal (vlax-curve-getstartpoint e) (vlax-curve-getendpoint x) 1e-6)
  69.                 )
  70.               ) (vl-remove e elst))
  71.             )
  72.             (vl-some '(lambda ( x )
  73.               (or
  74.                 (equal (vlax-curve-getendpoint e) (vlax-curve-getstartpoint x) 1e-6)
  75.                 (equal (vlax-curve-getendpoint e) (vlax-curve-getendpoint x) 1e-6)
  76.               )
  77.             ) (vl-remove e elst))
  78.           )
  79.         )
  80.         |;
  81.        (setq el2 (cons e el2))
  82.      )
  83.    )
  84.  )
  85.  (setq elst (append el1 el2 el3))
  86.  (if el1
  87.    (progn
  88.      (setq ssel1 (ssadd))
  89.      (foreach e el1
  90.        (ssadd e ssel1)
  91.      )
  92.      (prompt "\nSelected first type of lines... ENTER to CONTINUE...")
  93.      (sssetfirst nil ssel1)
  94.      (vl-catch-all-apply 'grread)
  95.    )
  96.    (prompt "\nNo lines of first type in specified selection set of lines...")
  97.  )
  98.  (if el2
  99.    (progn
  100.      (setq ssel2 (ssadd))
  101.      (foreach e el2
  102.        (ssadd e ssel2)
  103.      )
  104.      (prompt "\nSelected second type of lines... ENTER to CONTINUE...")
  105.      (sssetfirst nil ssel2)
  106.      (vl-catch-all-apply 'grread)
  107.    )
  108.    (prompt "\nNo lines of second type in specified selection set of lines...")
  109.  )
  110.  (if el3
  111.    (progn
  112.      (setq ssel3 (ssadd))
  113.      (foreach e el3
  114.        (ssadd e ssel3)
  115.      )
  116.      (prompt "\nSelected third type of lines... ENTER to CONTINUE...")
  117.      (sssetfirst nil ssel3)
  118.      (vl-catch-all-apply 'grread)
  119.    )
  120.    (prompt "\nNo lines of third type in specified selection set of lines...")
  121.  )
  122.  (sssetfirst nil nil)
  123.  (princ)
  124. )
  125.  

M.R.
9
AutoLISP (Vanilla / Visual) / how to calculate the correct nor?
« Last post by ssdd on December 03, 2016, 07:34:18 am »
Code - Auto/Visual Lisp: [Select]
  1. (defun c:tt()
  2. Space (if (= 1 (getvar "CVPORT"))(vla-get-PaperSpace AcDoc)(vla-get-ModelSpace AcDoc)))
  3.   (setq ss (ssget  (List (cons 0 "spline,line,arc,LWPOLYLINE"))) n -1)
  4.   (while (< n (- (sslength ss) 1))      
  5.    (setq e (ssname ss (setq n (1+ n))))
  6.    (setq en (vlax-ename->vla-object e))
  7.    (setq sta (vlax-curve-getStartPoint  en))
  8.    (setq end (vlax-curve-getEndPoint    en))
  9.    (setq nor (vlax-curve-getFirstDeriv en (vlax-curve-getStartParam en)));(Error, how to calculate the correct nor?)
  10.    (setq en1 (VL-AddLWPolyline Space (list(list 5 20 0)(list 5 -20 0)(list -5 -20 0)(list -5 20 0)):vlax-true))
  11.    (vla-put-Normal en1 (vlax-3d-Point nor))
  12.     (vla-Move  en1 (vlax-3d-Point  0 0 0) (vlax-3d-Point  sta))
  13. )
  14.  (vla-EndUndoMark AcDoc)
  15.  (princ))
  16.  
  17.  
  18.  
  19. (defun VL-AddLWPolyline (Space Pts Closed / obj)
  20.  (setq Pts
  21.    (apply
  22.      (quote append)
  23.      (mapcar
  24.        (function
  25.          (lambda (%)
  26.            (list (car %) (cadr %))
  27.          )
  28.        )
  29.        (mapcar
  30.          (function
  31.            (lambda (%)
  32.              (trans % 1 (trans '(0 0 1) 1 0 T))
  33.            )
  34.          )
  35.          Pts
  36.        )
  37.      )
  38.    )
  39.  )
  40.  (setq obj
  41.      (vlax-make-variant
  42.        (vlax-safearray-fill
  43.          (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length Pts))))
  44.          Pts
  45.        )
  46.      )
  47.    )
  48.  )
  49.  (if Closed (vla-put-closed obj Closed))
  50.  obj
  51. )


Edit (John) : Added code tags.
10
AutoLISP (Vanilla / Visual) / Re: Moving points by selecting polyline
« Last post by ahsattarian on December 03, 2016, 05:50:04 am »
hello
if your problem isn't solved tell me : ahsattarian3@gmail.com
i've written the same lisp
+989126049289
Amir
Pages: [1] 2 3 ... 10