Recent Posts

Pages: 1 ... 8 9 [10]
91
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by FABRICIO28 on February 16, 2017, 12:23:32 pm »
Why don't you make a block with an attribute?

Because I've exploded that elements from autocad civil 3D.  ;D
>:D  .. this is how I'd do it.

Wow!

Do you make a block with the circles and numbers. How could you do that?

Amazing
Code  ;)

I see...
Very impressive  :-)
92
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by ronjonp on February 16, 2017, 12:07:37 pm »
Why don't you make a block with an attribute?

Because I've exploded that elements from autocad civil 3D.  ;D
>:D  .. this is how I'd do it.

Wow!

Do you make a block with the circles and numbers. How could you do that?

Amazing
Code  ;)
93
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by FABRICIO28 on February 16, 2017, 12:00:17 pm »
Why don't you make a block with an attribute?

Because I've exploded that elements from autocad civil 3D.  ;D
>:D  .. this is how I'd do it.

Wow!

Do you make a block with the circles and numbers. How could you do that?

Amazing
94
AutoLISP (Vanilla / Visual) / Re: Problem with 2dwireframe
« Last post by velasquez on February 16, 2017, 11:52:16 am »
Try 25 & regen.

Thank you
This value for isolines does not work well on all the drawings in my library.
I can not understand why the problem does not happen if you use the "_explode" command in the block or when you change the Visual Style to 3D wireframe.
95
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by ronjonp on February 16, 2017, 11:51:03 am »
Why don't you make a block with an attribute?

Because I've exploded that elements from autocad civil 3D.  ;D
>:D  .. this is how I'd do it.
96
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by Andrea on February 16, 2017, 11:48:05 am »
Code: [Select]
(defun c:SSIM (/ circles #count centerp item Mtexts MtextObject vlaitem)
  (setq circles (ssget "_X"
       '((0 . "CIRCLE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "-NRO-LOTE")
(100 . "AcDbCircle")
)
)
  )
  (repeat (setq #count (sslength circles))
    (setq item (ssname circles (setq #count (1- #count))))
    (setq centerp (assoc 10 (entget item)))
    (if (setq Mtexts (ssget "_X"
    (list
      '(0 . "MTEXT")
      centerp
    )
     )
)
      (progn
(setq MtextObject (ssname Mtexts 0))
(setq vlaitem (vlax-ename->vla-object MTextobject))
(vla-put-layer vlaitem "-NRO-LOTE")
      )
    )

  )
  (princ)
)

If the circle were in the " -AREA-LOTE" the code isn't working.

My first step is change the circle and the number to "-NRO-LOTE".
But I can select the similar all circle and change the layer as I want to. But couldn't do that to the number.

Will be good if I able to change boths (circle and Number) to "-NRO-LOTE" layer.

Thanks

why do not mix both code ?
my filtering object is to detext all circle and compare centerpoints to MTEXT who have same centerpoints..

but you can use Ron filtering selection.. :)
or,..
remove the layer filtering..
Code: [Select]
(setq circles (ssget "_X"
       '((0 . "CIRCLE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
; (8 . "-NRO-LOTE")
(100 . "AcDbCircle")
)
)
  )
97
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by FABRICIO28 on February 16, 2017, 11:43:22 am »
Why don't you make a block with an attribute?

Because I've exploded that elements from autocad civil 3D.  :-D

98
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by ronjonp on February 16, 2017, 11:38:17 am »
Why don't you make a block with an attribute?
99
AutoLISP (Vanilla / Visual) / Re: Select the similiar
« Last post by FABRICIO28 on February 16, 2017, 11:34:40 am »
Code: [Select]
(defun c:SSIM (/ circles #count centerp item Mtexts MtextObject vlaitem)
  (setq circles (ssget "_X"
       '((0 . "CIRCLE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "-NRO-LOTE")
(100 . "AcDbCircle")
)
)
  )
  (repeat (setq #count (sslength circles))
    (setq item (ssname circles (setq #count (1- #count))))
    (setq centerp (assoc 10 (entget item)))
    (if (setq Mtexts (ssget "_X"
    (list
      '(0 . "MTEXT")
      centerp
    )
     )
)
      (progn
(setq MtextObject (ssname Mtexts 0))
(setq vlaitem (vlax-ename->vla-object MTextobject))
(vla-put-layer vlaitem "-NRO-LOTE")
      )
    )

  )
  (princ)
)

If the circle were in the " -AREA-LOTE" the code isn't working.

My first step is change the circle and the number to "-NRO-LOTE".
But I can select the similar all circle and change the layer as I want to. But couldn't do that to the number.

Will be good if I able to change boths (circle and Number) to "-NRO-LOTE" layer.

Thanks
100
AutoLISP (Vanilla / Visual) / CopyObjects and Layouts (also trans DCS ObjectDBX)
« Last post by T.Willey on February 16, 2017, 11:29:36 am »
I though it might be fun to see what I can come up with for a better Tab -> Drawings routine.  I had to use one a couple of months ago, and would have liked it to be smarter, so I thought to create one which would look at all viewports per layout, and only copy those model space objects that are visible through the viewports per layout.  Base is working expect two parts:

1) One of the layouts does not seem to be self generating a main viewport.  I do not see a real pattern, as I thought it was the last tab, so I created a new one through the right-click menu, and it would still not create the viewport.  I reordered the tab, and the same issue happened.  I tried creating a new layout by the command line, and it was still there.  Here is an output for the command (does not matter if called from current drawing or ObjectDBX):
Quote
Command: T2D
Layout: created, before: 0, after: 3, copied: 3
Layout: copy2, before: 0, after: 5, copied: 4
Layout: test2, before: 0, after: 5, copied: 4
Layout: yes, before: 0, after: 4, copied: 3
Layout: yes (2), before: 0, after: 4, copied: 3
Command:
you can see that all have 1 more object in the layout space than the copied amount except the 'created' drawing.  Everything time I run the command, it is always the 'created' layout which does not get the correct amount of objects.  Before it was the 'test2' layout.  Between testing, I created the 'yes (2)' layout, but the 'test2' layout would still be the layout with the wrong amount of objects.

2) I have not been able to find a way to 'trans' the viewport coordinate for the viewport center (of model space) to WCS.  I want this to work with ODBX, so I cannot change into model space and use (trans pt 2 0).  I will continue to look for this answer.

The test drawing is attached.  Right now the default save path is "c:/test/", but that can be changed.  Also with the ODBX version of the command, it looks for the attached drawing in the same directory.

edit:  updated code, add Gile's routine per Lee's link.
edit:  updated code to correct issue 1 in this post
Code: [Select]
(defun c:TabsToDwgs ()
    (tabsToDwgs (vla-get-ActiveDocument (vlax-get-Acad-Object)) "c:/test/" nil)
    (princ)
)
;======================================================

(defun c:t2d ( / *error* dbxdoc oVer dir)
   
    (defun *error* (msg)
        (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
            (vlax-release-object dbxdoc)
        )
        (if msg (vl-bt))
    )
;------------------------------------------------------
    (setq dbxdoc
        (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
            (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
            (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
        )
    )
    (setq dir "c:/test/")
    (vla-Open dbxdoc (strcat dir "tabs2dwgs.dwg") :vlax-true)
    (tabsToDwgs dbxdoc "c:/test/" t)
    (*error* nil)
    (princ)
)
;======================================================

(defun tabsToDwgs ( doc dir needrelease / *error* getItems doesIntersect
                    getBoundingPoints isWithinCross getViewPoints findLike
                    doesPropertyMatch
                    doc name lst vplist fvp lolist msobjs xdata pt sc wd ht
                    pts tlist olist dbxdoc oVer dir vp acname polist )
;-------------------------------------------------------
    (defun *error* (msg)
        (if dbxdoc (vlax-release-object dbxdoc))
        (if (and doc needrelease) (vlax-release-object doc))
        (if msg (vl-bt))
    )
;------------------------------------------------------
    (defun getItems (lst code pos / cnt rtn )
        (setq cnt 0)
        (foreach i lst
            (if (equal (car i) code)
                (progn
                    (setq cnt (1+ cnt))
                    (if (member cnt pos)
                        (setq rtn (cons (cdr i) rtn))
                    )
                )
            )
        )
        (reverse rtn)
    )
;-------------------------------------------------------
    (defun doesIntersect ( pt pt2 pts on )
        (or
            (inters pt pt2 (car pts) (cadr pts) on)
            (inters pt pt2 (cadr pts) (caddr pts) on)
            (inters pt pt2 (caddr pts) (cadddr pts) on)
            (inters pt pt2 (car pts) (cadddr pts) on)
        )
    )
;-------------------------------------------------------
    (defun getBoundingPoints ( obj / ll ur err )
        (cond
            ((= (vla-get-ObjectName obj) "AcDbXline")
               (list
                   (vlax-get obj 'BasePoint)
                   (vlax-get obj 'SecondPoint)
               )
            )
            (t
                (setq err
                    (vl-catch-all-apply
                        (function vla-GetBoundingBox)
                        (list obj 'll 'ur)
                    )
                )
                (if
                    (not
                        (and
                            (vl-catch-all-error-p err)
                            (= (vl-catch-all-error-message err)
                                "Automation Error. Null extents")
                        )
                    )
                    (progn
                        (setq ll (safearray-value ll))
                        (setq ur (safearray-value ur))
                        (list
                            ll
                            (list (car ll) (cadr ur) (caddr ll))
                            ur
                            (list (car ur) (cadr ll) (caddr ll))
                        )
                    )
                )
            )
        )
    )
;-------------------------------------------------------
    (defun isWithinCross ( objpts bndpts / ll ur err )
        (if (equal (length objpts) 2)
            (doesIntersect (car objpts) (cadr objpts) bndpts nil)
            (progn
                (or
                    (and
                        (<= (caar bndpts) (caar objpts) (caaddr bndpts))
                        (<= (cadar bndpts) (cadar objpts) (cadadr bndpts))
                        (<= (caar bndpts) (caaddr objpts) (caaddr bndpts))
                        (<= (cadar bndpts) (cadar (cddr objpts)) (cadadr bndpts))
                    )
                    (doesIntersect (car objpts) (cadr objpts)  bndpts t)
                    (doesIntersect (cadr objpts) (caddr objpts)  bndpts t)
                    (doesIntersect (caddr objpts) (cadddr objpts)  bndpts t)
                    (doesIntersect (cadddr objpts) (car objpts)  bndpts t)
                )
            )
        )
    )
;-------------------------------------------------------
    (defun getViewPoints ( vp / xdata pt sc wd ht )
        (setq xdata (MyGetXdata vp "ACAD"))
        (setq pt (PCS2WCS (vlax-get vp 'Center) vp))
        (setq sc (vlax-get vp 'CustomScale))
        (setq wd (/ (vlax-get vp 'Width) sc 2))
        (setq ht (/ (vlax-get vp 'Height) sc 2))
        (list
            (list (- (car pt) wd) (- (cadr pt) ht))
            (list (- (car pt) wd) (+ (cadr pt) ht))
            (list (+ (car pt) wd) (+ (cadr pt) ht))
            (list (+ (car pt) wd) (- (cadr pt) ht))
        )
    )
;-------------------------------------------------------
    (defun doesPropertyMatch ( o1 o2 prop )
        (equal (vlax-get o1 prop) (vlax-get o2 prop))
    )
;-------------------------------------------------------
    (defun findLike ( src olist / obj )
        (foreach o olist
            (if
                (and
                    (doesPropertyMatch src o "ObjectName")
                    (doesPropertyMatch src o "Center")
                    (doesPropertyMatch src o "CustomScale")
                    (doesPropertyMatch src o "Direction")
                    (doesPropertyMatch src o "Height")
                    (doesPropertyMatch src o "TwistAngle")
                    (doesPropertyMatch src o "Width")
                )
                (setq obj o)
            )
        )
        obj
    )
;-------------------------------------------------------
    ;; PCS2WCS (gile)
    ;; Translates a point PaperSpace coordinates to WCS coordinates
    ;; according to the specified viewport
    ;;
    ;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
    ;;
    ;; Arguments
    ;; pt : a point
    ;; vp : the viewport (ename or vla-object)

    (defun PCS2WCS (pt vp / ang nor scl mat)
      (vl-load-com)
      (and (= (type vp) 'VLA-OBJECT)
           (setq vp (vlax-vla-object->ename vp))
      )
      (setq pt   (trans pt 0 0)
        elst (entget vp)
        ang  (- (cdr (assoc 51 elst)))
        nor  (cdr (assoc 16 elst))
        scl  (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst)))
        mat  (mxm
               (mapcar (function (lambda (v) (trans v 0 nor T)))
                   '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
               )
               (list (list (cos ang) (- (sin ang)) 0.0)
                 (list (sin ang) (cos ang) 0.0)
                 '(0.0 0.0 1.0)
               )
             )
      )
      (mapcar '+
          (mxv mat
               (mapcar '+
                   (vxs pt scl)
                   (vxs (cdr (assoc 10 elst)) (- scl))
                   (cdr (assoc 12 elst))
               )
          )
          (cdr (assoc 17 elst))
      )
    )

    ;; VXS Multiply a vector by a scalar
    ;;
    ;; Arguments : a vector and a real

    (defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v))

    ;; VXV (gile)
    ;; Returns the dot product of two vectors (real)
    ;;
    ;; Arguments : two vectors
    ;; return : a real number

    (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)))

    ;; TRP
    ;; transposes a matrix -Doug Wilson-
    ;;
    ;; Argument : a matrix
    ;; return : a matrix

    (defun trp (m) (apply 'mapcar (cons 'list m)))

    ;; MXV
    ;; Applies a transformation matrix to a vector  -Vladimir Nesterovsky-
    ;;
    ;; Arguments : une matrice et un vecteur
    ;; return : a vector

    (defun mxv (m v)
      (mapcar '(lambda (r) (vxv r v)) m)
    )

    ;; MXM
    ;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
    ;;
    ;; Arguments : deux matrices
    ;; return : a matrix

    (defun mxm (m q)
      (mapcar '(lambda (r) (mxv (trp q) r)) m)
    )
;-------------------------------------------------------
    (setq acname (vla-get-Name (vla-get-Layout (vla-get-PaperSpace doc))))
    (vlax-for lo (vla-get-Layouts doc)
        (setq name (vla-get-Name lo))
        (setq lst nil)
        (setq vplist nil)
        (Setq fvp nil)
        (vlax-for o (vla-get-Block lo)
            (setq lst (cons o lst))
            (if (and
                    (equal (vla-get-ModelType lo) :vlax-false)
                    (= (vla-get-ObjectName o) "AcDbViewport")
                )
                (setq vplist (cons (cons o (getViewPoints o)) vplist))
            )
            (if (and vplist (not fvp))
                (progn
                    (setq fvp t)
                    (setq vplist nil)
                    (setq lst (vl-remove o lst))
                )
            )
        )
        (setq lolist
            (cons
                (list
                    name
                    (cons "objects" lst)
                    (cons "viewports" vplist)
                )
                lolist
            )
        )
    )
    (setq msobjs (cdr (assoc "objects" (cdr (assoc "Model" lolist)))))
    (foreach o msobjs
        (if (setq bpts (getBoundingPoints o))
            (foreach l lolist
                (setq name (car l))
                (foreach vp (cdr (assoc "viewports" (cdr l)))
                    (if (isWithinCross bpts (cdr vp))
                        (if (setq tlist (assoc name olist))
                            (if (not (vl-position o (cdr tlist)))
                                (setq olist
                                    (subst
                                        (cons name (cons o (cdr tlist)))
                                        tlist
                                        olist
                                    )
                                )
                            )
                            (setq olist (cons (cons name (list o)) olist))
                        )
                    )
                )
            )
        )
    )
    (foreach l lolist
        (setq name (car l))
        (if (/= name "Model")
            (progn
                (setq dbxdoc
                    (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
                        (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
                        (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))
                    )
                )
                (if (setq tlist (cdr (assoc name olist)))
                    (vlax-invoke
                        doc
                        'CopyObjects
                        tlist
                        (vla-get-ModelSpace dbxdoc)
                    )
                )
                (if (= name acname)
                    (setq vp (vlax-invoke (vla-get-PaperSpace dbxdoc) 'AddpViewport '(0. 0. 0.) 1. 1.))
                )
                (setq polist (cdr (assoc "objects" (cdr l))))
                (setq objs
                    (vlax-invoke
                        doc
                        'CopyObjects
                        polist
                        (vla-get-Block (vla-item (vla-get-Layouts dbxdoc) "Layout1"))
                    )
                )
                (if vp (vla-Delete vp))
                (vla-SaveAs dbxdoc (strcat dir name ".dwg"))
                (if vp
                    (progn
                        (setq vp nil)
                        (vla-Open dbxdoc (strcat dir name ".dwg"))
                        (vlax-for o (vla-get-Block (vla-item (vla-get-Layouts dbxdoc) "Layout1"))
                            (if
                                (and
                                    (= (vla-get-ObjectName o) "AcDbViewport")
                                    (setq obj (findLike o polist))
                                )
                                (vla-put-ViewportOn o (vla-get-ViewportOn obj))
                            )
                        )
                        (vla-SaveAs dbxdoc (strcat dir name ".dwg"))
                    )
                )
                (vlax-release-object dbxdoc)
                (setq dbxdoc nil)
            )
        )
 
    )
    (*error* nil)
    (princ)
)

I think I have included everything.

Thanks in advance.
Pages: 1 ... 8 9 [10]