Jump to content

Lisp NEEDED: Place Node at center of Circles

Jadeous

By Jadeous
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Jadeous Collaborator

Jadeous

Posted
Posted

Hello. It's been awhile since I've been on here. Missed you guys. :)

 

I need to ask if anyone has or can write me a Lisp routine that will place a node at the center of multiple (100+) circles in a drawing. I need something 2D. Elevation in 3D is not an issue.

 

Sounds simple enough, but my guys here at work are stumped.

 

Any help would be great!

 

Running:

AutoCad 2012 and AutoCad MEP 2012

Windows 7 Proffesional 64-bit

Link to comment
Share on other sites
MSasu Grand Master

MSasu

Posted
Posted

Rescued from a previous thread and adjusted a little:

;Add Points to Circles (11-VII-2012)
(defun c:APC( / ssetCircles countCircles itemCircle assocCircle assocPoint  )
(if (setq ssetCircles (ssget "_X" '((0 . "CIRCLE"))))
 (repeat (setq countCircles (sslength ssetCircles))
  (setq itemCircle (ssname ssetCircles 0)
        assocCircle (entget itemCircle)
        assocPoint  '((0 . "POINT")))
  (foreach codeDXF '(10 8 410 210)
   (setq assocPoint (append assocPoint (list (assoc codeDXF assocCircle))))
  )
  (if (assoc 62 assocCircle) 
   (setq assocPoint (append assocPoint (list (assoc 62 assocCircle)))))
  (if (assoc 6 assocCircle) 
   (setq assocPoint (append assocPoint (list (assoc 6 assocCircle))))) ;???
  (entmakex assocPoint)
  (ssdel itemCircle ssetCircles)
 )
)
(prompt (strcat "\nReplaced " (itoa countCircles) " circles."))
(princ)
)

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

maybe ....

 

(defun c:Test (/ ss)
 (if (setq ss (ssget "_x" '((0 . "CIRCLE"))))
   ((lambda (i / sn e)
      (while (setq sn (ssname ss (setq i (1+ i))))
         (entmakex (list '(0 . "POINT") (assoc 10 (setq e (entget sn)))(assoc 8 e)))))
     -1
   )
   (princ)
 )
 (princ)
)

Link to comment
Share on other sites
Jadeous Collaborator

Jadeous

Posted
  • Author
Posted

The "APC" one is very close.

 

The situation I am using this command for is when I Xref in a drawing with circles to represent piping stands. I need to place a Node in the current drawing inside center of the circles and then detach the Xref. So replacing the circles is not nessesary.

 

Maybe having a Lisp that looks for the centers, not specifically circles.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
The situation I am using this command for is when I Xref in a drawing with circles to represent piping stands. I need to place a Node in the current drawing inside center of the circles and then detach the Xref.

 

The following should work for Blocks / Dynamic Blocks / XRefs, with any orientation, scale or rotation:

 

[color=GREEN];; Points at Circle Centres within Block  -  Lee Mac[/color]
[color=GREEN];; Prompts for selection of a block and creates points in modelspace[/color]
[color=GREEN];; at the centre of every circle in the selected block[/color]

([color=BLUE]defun[/color] c:ptcirblk ( [color=BLUE]/[/color] bd en ml )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect Block: "[/color])))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))
                   ([color=BLUE]if[/color] ([color=BLUE]/=[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] en))))
                       ([color=BLUE]princ[/color] [color=MAROON]"\nSelected Object is not a Block."[/color])
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] en
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] bd ([color=BLUE]tblobjname[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] en))))
                 ml (RefGeom en)
           )
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]entnext[/color] bd))
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"CIRCLE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] bd))))
                   ([color=BLUE]entmake[/color]
                       ([color=BLUE]list[/color]
                          '(0 . [color=MAROON]"POINT"[/color])
                           ([color=BLUE]cons[/color] 10 ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] (mxv ([color=BLUE]car[/color] ml) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]entget[/color] bd)))) ([color=BLUE]cadr[/color] ml)))
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; RefGeom (gile)[/color]
[color=GREEN];; Returns a list which first item is a 3x3 transformation matrix (rotation,[/color]
[color=GREEN];; scales, normal) and second item the object insertion point in its parent[/color]
[color=GREEN];; (xref, block or space)[/color]
[color=GREEN];;[/color]
[color=GREEN];; Argument : an ename[/color]

([color=BLUE]defun[/color] RefGeom ( ename [color=BLUE]/[/color] elst ang norm mat )
   ([color=BLUE]setq[/color] elst ([color=BLUE]entget[/color] ename)
         ang  ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 50 elst))
         norm ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 elst))
   )
   ([color=BLUE]list[/color]
       ([color=BLUE]setq[/color] mat
           (mxm
               ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( v ) ([color=BLUE]trans[/color] v 0 norm [color=BLUE]t[/color]))
                  '(
                       (1.0 0.0 0.0)
                       (0.0 1.0 0.0)
                       (0.0 0.0 1.0)
                   )
               )
               (mxm
                   ([color=BLUE]list[/color]
                       ([color=BLUE]list[/color] ([color=BLUE]cos[/color] ang) ([color=BLUE]-[/color] ([color=BLUE]sin[/color] ang)) 0.0)
                       ([color=BLUE]list[/color] ([color=BLUE]sin[/color] ang) ([color=BLUE]cos[/color] ang)     0.0)
                      '(0.0 0.0 1.0)
                   )
                   ([color=BLUE]list[/color]
                       ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 41 elst)) 0.0 0.0)
                       ([color=BLUE]list[/color] 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 42 elst)) 0.0)
                       ([color=BLUE]list[/color] 0.0 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 43 elst)))
                   )
               )
           )
       )
       ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 elst)) norm 0)
           (mxv mat ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 elst))))))
       )
   )
)

[color=GREEN];; Matrix Transpose  -  Doug Wilson[/color]
[color=GREEN];; Args: m - nxn matrix[/color]

([color=BLUE]defun[/color] trp ( m )
   ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]list[/color] m))
)

[color=GREEN];; Matrix x Vector  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m - nxn matrix, v - vector in R^n[/color]

([color=BLUE]defun[/color] mxv ( m v )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) ([color=BLUE]apply[/color] '[color=BLUE]+[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]*[/color] r v))) m)
)

[color=GREEN];; Matrix x Matrix  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m,n - nxn matrices[/color]

([color=BLUE]defun[/color] mxm ( m n )
   (([color=BLUE]lambda[/color] ( a ) ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) (mxv a r)) m)) (trp n))
)

([color=BLUE]princ[/color])

Link to comment
Share on other sites
Jadeous Collaborator

Jadeous

Posted
  • Author
Posted

If it helps, I am working with TSI stands. Each stand has a circle around it for the "clearance area".

 

If I explode the Stand, the circle disappears and the rest of the stand becomes 3d faces.

 

So maybe that is why the lisp from Lee Mac isn't working on the drawing. The TSI items are not considered blocks.

 

If I can find a way to extract that circle from the TSI stand, I can use the first lisp on this thread or find a lisp that will recognize the circle in the item.

Link to comment
Share on other sites
Jadeous Collaborator

Jadeous

Posted
  • Author
Posted

My apologizes.

 

I did not realize how specific the dteails would need to be.

 

It is truely amazing how simple concepts require such detailed solutions.

Link to comment
Share on other sites
Jadeous Collaborator

Jadeous

Posted
  • Author
Posted

They are a Cadduct item.

 

TSI is the company that sells the software and they also know that when are in need of this lisp tool, but they want more money to give it to us.

 

So I was hoping to find a work-around for the time being.

 

I figured if I could find a lisp that places a node at the centers of an xref'd Cadduct item, I would cool for now.

Link to comment
Share on other sites
Jadeous Collaborator

Jadeous

Posted
  • Author
Posted

I loaded the Lisp and ran the EE command.

 

This is what came up in the command bar:

 

Command: ee

Select object:

(

(-1 . )

(0 . "MAPS_SOLID")

(330 . )

(5 . "21BE")

(100 . "AcDbEntity")

(67 . 0)

(410 . "Model")

(8 . "MP-HNGR")

(8 . "MP-HNGR")

(300 . "3-1/2")

(300 . "Celgene: 2nd Floor (+15'-0\")")

(300 . "Pipework: Carbon Steel")

(300 . "Carbon Steel x 0.0")

(300 . "4")

(300 . "7")

(300 . "0 (inch)")

(300 . "0")

(300 . "0")

(300 . "")

(300 . "ASJ x 1.5")

)

Command:

 

Nothing happened after that.

Link to comment
Share on other sites
  • 2 years later...
danthecadman Rookie

danthecadman

Posted
Posted
The following should work for Blocks / Dynamic Blocks / XRefs, with any orientation, scale or rotation:

 

[color=GREEN];; Points at Circle Centres within Block  -  Lee Mac[/color]
[color=GREEN];; Prompts for selection of a block and creates points in modelspace[/color]
[color=GREEN];; at the centre of every circle in the selected block[/color]

([color=BLUE]defun[/color] c:ptcirblk ( [color=BLUE]/[/color] bd en ml )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect Block: "[/color])))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))
                   ([color=BLUE]if[/color] ([color=BLUE]/=[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] en))))
                       ([color=BLUE]princ[/color] [color=MAROON]"\nSelected Object is not a Block."[/color])
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] en
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] bd ([color=BLUE]tblobjname[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] en))))
                 ml (RefGeom en)
           )
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]entnext[/color] bd))
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"CIRCLE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] bd))))
                   ([color=BLUE]entmake[/color]
                       ([color=BLUE]list[/color]
                          '(0 . [color=MAROON]"POINT"[/color])
                           ([color=BLUE]cons[/color] 10 ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] (mxv ([color=BLUE]car[/color] ml) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]entget[/color] bd)))) ([color=BLUE]cadr[/color] ml)))
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; RefGeom (gile)[/color]
[color=GREEN];; Returns a list which first item is a 3x3 transformation matrix (rotation,[/color]
[color=GREEN];; scales, normal) and second item the object insertion point in its parent[/color]
[color=GREEN];; (xref, block or space)[/color]
[color=GREEN];;[/color]
[color=GREEN];; Argument : an ename[/color]

([color=BLUE]defun[/color] RefGeom ( ename [color=BLUE]/[/color] elst ang norm mat )
   ([color=BLUE]setq[/color] elst ([color=BLUE]entget[/color] ename)
         ang  ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 50 elst))
         norm ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 elst))
   )
   ([color=BLUE]list[/color]
       ([color=BLUE]setq[/color] mat
           (mxm
               ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( v ) ([color=BLUE]trans[/color] v 0 norm [color=BLUE]t[/color]))
                  '(
                       (1.0 0.0 0.0)
                       (0.0 1.0 0.0)
                       (0.0 0.0 1.0)
                   )
               )
               (mxm
                   ([color=BLUE]list[/color]
                       ([color=BLUE]list[/color] ([color=BLUE]cos[/color] ang) ([color=BLUE]-[/color] ([color=BLUE]sin[/color] ang)) 0.0)
                       ([color=BLUE]list[/color] ([color=BLUE]sin[/color] ang) ([color=BLUE]cos[/color] ang)     0.0)
                      '(0.0 0.0 1.0)
                   )
                   ([color=BLUE]list[/color]
                       ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 41 elst)) 0.0 0.0)
                       ([color=BLUE]list[/color] 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 42 elst)) 0.0)
                       ([color=BLUE]list[/color] 0.0 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 43 elst)))
                   )
               )
           )
       )
       ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 elst)) norm 0)
           (mxv mat ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 elst))))))
       )
   )
)

[color=GREEN];; Matrix Transpose  -  Doug Wilson[/color]
[color=GREEN];; Args: m - nxn matrix[/color]

([color=BLUE]defun[/color] trp ( m )
   ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]list[/color] m))
)

[color=GREEN];; Matrix x Vector  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m - nxn matrix, v - vector in R^n[/color]

([color=BLUE]defun[/color] mxv ( m v )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) ([color=BLUE]apply[/color] '[color=BLUE]+[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]*[/color] r v))) m)
)

[color=GREEN];; Matrix x Matrix  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m,n - nxn matrices[/color]

([color=BLUE]defun[/color] mxm ( m n )
   (([color=BLUE]lambda[/color] ( a ) ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) (mxv a r)) m)) (trp n))
)

([color=BLUE]princ[/color])

 

 

Thank you so much!! I just had to calc civil3d points for over 300 penos for a surveyor to set out. You just saved me over 2 hours work. I think I owe you a beer!

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Thank you so much!! I just had to calc civil3d points for over 300 penos for a surveyor to set out. You just saved me over 2 hours work. I think I owe you a beer!

 

Thanks Dan! - I'm delighted that you found the program so useful and that it has saved you so much time!

 

Cheers,

 

Lee

Link to comment
Share on other sites
  • 3 years later...
minhphuong_humg Enthusiast

minhphuong_humg

Posted
Posted
The following should work for Blocks / Dynamic Blocks / XRefs, with any orientation, scale or rotation:

 

[color=GREEN];; Points at Circle Centres within Block  -  Lee Mac[/color]
[color=GREEN];; Prompts for selection of a block and creates points in modelspace[/color]
[color=GREEN];; at the centre of every circle in the selected block[/color]

([color=BLUE]defun[/color] c:ptcirblk ( [color=BLUE]/[/color] bd en ml )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect Block: "[/color])))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))
                   ([color=BLUE]if[/color] ([color=BLUE]/=[/color] [color=MAROON]"INSERT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] en))))
                       ([color=BLUE]princ[/color] [color=MAROON]"\nSelected Object is not a Block."[/color])
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] en
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] bd ([color=BLUE]tblobjname[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 ([color=BLUE]entget[/color] en))))
                 ml (RefGeom en)
           )
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]entnext[/color] bd))
               ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"CIRCLE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] bd))))
                   ([color=BLUE]entmake[/color]
                       ([color=BLUE]list[/color]
                          '(0 . [color=MAROON]"POINT"[/color])
                           ([color=BLUE]cons[/color] 10 ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] (mxv ([color=BLUE]car[/color] ml) ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]entget[/color] bd)))) ([color=BLUE]cadr[/color] ml)))
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; RefGeom (gile)[/color]
[color=GREEN];; Returns a list which first item is a 3x3 transformation matrix (rotation,[/color]
[color=GREEN];; scales, normal) and second item the object insertion point in its parent[/color]
[color=GREEN];; (xref, block or space)[/color]
[color=GREEN];;[/color]
[color=GREEN];; Argument : an ename[/color]

([color=BLUE]defun[/color] RefGeom ( ename [color=BLUE]/[/color] elst ang norm mat )
   ([color=BLUE]setq[/color] elst ([color=BLUE]entget[/color] ename)
         ang  ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 50 elst))
         norm ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 elst))
   )
   ([color=BLUE]list[/color]
       ([color=BLUE]setq[/color] mat
           (mxm
               ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( v ) ([color=BLUE]trans[/color] v 0 norm [color=BLUE]t[/color]))
                  '(
                       (1.0 0.0 0.0)
                       (0.0 1.0 0.0)
                       (0.0 0.0 1.0)
                   )
               )
               (mxm
                   ([color=BLUE]list[/color]
                       ([color=BLUE]list[/color] ([color=BLUE]cos[/color] ang) ([color=BLUE]-[/color] ([color=BLUE]sin[/color] ang)) 0.0)
                       ([color=BLUE]list[/color] ([color=BLUE]sin[/color] ang) ([color=BLUE]cos[/color] ang)     0.0)
                      '(0.0 0.0 1.0)
                   )
                   ([color=BLUE]list[/color]
                       ([color=BLUE]list[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 41 elst)) 0.0 0.0)
                       ([color=BLUE]list[/color] 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 42 elst)) 0.0)
                       ([color=BLUE]list[/color] 0.0 0.0 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 43 elst)))
                   )
               )
           )
       )
       ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 elst)) norm 0)
           (mxv mat ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ([color=BLUE]tblsearch[/color] [color=MAROON]"BLOCK"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 elst))))))
       )
   )
)

[color=GREEN];; Matrix Transpose  -  Doug Wilson[/color]
[color=GREEN];; Args: m - nxn matrix[/color]

([color=BLUE]defun[/color] trp ( m )
   ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]list[/color] m))
)

[color=GREEN];; Matrix x Vector  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m - nxn matrix, v - vector in R^n[/color]

([color=BLUE]defun[/color] mxv ( m v )
   ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) ([color=BLUE]apply[/color] '[color=BLUE]+[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]*[/color] r v))) m)
)

[color=GREEN];; Matrix x Matrix  -  Vladimir Nesterovsky[/color]
[color=GREEN];; Args: m,n - nxn matrices[/color]

([color=BLUE]defun[/color] mxm ( m n )
   (([color=BLUE]lambda[/color] ( a ) ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( r ) (mxv a r)) m)) (trp n))
)

([color=BLUE]princ[/color])

 

Help me, edit to SELECT (by windows) multi Block?

Thanks.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Help me, edit to SELECT (by windows) multi Block?

 

Change the first function to:

;; Points at Circle Centres within Block  -  Lee Mac
;; Prompts for selection of a block and creates points in modelspace
;; at the centre of every circle in the selected block

(defun c:ptcirblk ( / bn cl en id ml ss )
   (if (setq ss (ssget '((0 . "INSERT"))))
       (repeat (setq id (sslength ss))
           (setq id (1- id)
                 en (ssname ss id)
                 bn (cdr (assoc 2 (entget en)))
                 ml (refgeom en)
           )
           (foreach pt
               (cond
                   (   (assoc bn cl)
                       (cdr (assoc bn cl))
                   )
                   (   (   (lambda ( bd / bl bx )
                               (while (setq bd (entnext bd))
                                   (if (= "CIRCLE" (cdr (assoc 0 (setq bx (entget bd)))))
                                       (setq bl (cons (trans (cdr (assoc 10 bx)) (cdr (assoc 210 bx)) 0) bl))
                                   )
                               )
                               (setq cl (cons (cons bn bl) cl))
                               bl
                           )
                           (tblobjname "block" bn)
                       )
                   )
               )
               (entmake
                   (list
                      '(0 . "POINT")
                       (cons 10 (mapcar '+ (mxv (car ml) pt) (cadr ml)))
                   )
               )
           )
       )
   )
   (princ)
)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...