HELP: Macro script or lisp to draw a cross in paper space at 0,0 in a single command

[vernonlee]

Looking for a macro or lisp that can do the following in a single command:-

 

1. draw a cross (using defpoint layer but colour change to Green)

- in paper-space environment

- length of the cross about 5mm

2. Place the center of this cross at the point 0,0

 

Purpose is to help me visually see if the title bk is align to 0,0.

 

Alternatively if there is a native command within autocad then do advise.

 

Thanks

Edited November 27, 2014 by vernonlee
solved

[Tharwat]

With lisp program life becomes easy Try this lisp program and let me know .

 

(defun c:cross nil
;; Tharwat 27.Nov.2014   ;;
 (mapcar '(lambda (x)
            (entmake (list '(0 . "LINE")
                           '(8 . "Defpoints")
                           '(62 . 3)
                           (cons 10 (polar '(0. 0. 0.) (car x) 5.))
                           (cons 11 (polar '(0. 0. 0.) (cadr x) 5.))
                     )
            )
          )
         '((0.785398 3.92699) (2.35619 5.49778))
 )
 (princ)
)

[vernonlee]

With lisp program life becomes easy Try this lisp program and let me know .

 

(defun c:cross nil
;; Tharwat 27.Nov.2014   ;;
 (mapcar '(lambda (x)
            (entmake (list '(0 . "LINE")
                           '(8 . "Defpoints")
                           '(62 . 3)
                           (cons 10 (polar '(0. 0. 0.) (car x) 5.))
                           (cons 11 (polar '(0. 0. 0.) (cadr x) 5.))
                     )
            )
          )
         '((0.785398 3.92699) (2.35619 5.49778))
 )
 (princ)
)

 

Cool. But i realised it is too small. How do i change the cross to 50mm instead?

 

Thanks

[Tharwat]

Cool. But i realised it is too small. How do i change the cross to 50mm instead?

 

Thanks

 

Just change the number 5 to 50 in the routine .

 

e.g.

(cons 10 (polar '(0. 0. 0.) (car x) [color="blue"]50.[/color]))
(cons 11 (polar '(0. 0. 0.) (cadr x) [color="blue"]50.[/color]))

[vernonlee]

Just change the number 5 to 50 in the routine .

 

e.g.

(cons 10 (polar '(0. 0. 0.) (car x) [color=blue]50.[/color]))
(cons 11 (polar '(0. 0. 0.) (cadr x) [color=blue]50.[/color]))

 

 

Great bro. Thanks alot

[Tharwat]

Great bro. Thanks alot

 

You are most welcome

[ttray33y]

also, my NOOB routine with variable length

(setq l1 "100,0,0") ;sets the second point of the line
(defun c:test () 
(setvar "filedia" 0)
(setvar "cmdecho" 1)
(setvar "orthomode" 1)
(setq cl1 (getstring (strcat "\nEnter Line X, <" l1 ">: ")))
(if (= cl1 "")
    (setq cl1 l1)
    (setq l1 cl1)
)
(command "clayer" "Defpoints")

(command "celtype" "Bylayer")
(command "line" "0,0,0" l1 "" "")
(command "-array" "l" "" "p" "0,0,0" "4" "" "")
(command "zoom" "C" "0,0,0" "250")
(setvar "filedia" 1)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(princ)

) 

Edited November 28, 2014 by ttray33y

[BIGAL]

Why not pick block and display a offset just 2 lines of code

 

(setq obj (entget (car (entsel "\nPick title block"))))
(alert (strcat "Title block is at   " (rtos (car (assoc 10 obj)) 2 1) "," (rtos (cadr (assoc 10 obj)) 2 1 )))

 

Ok read your other post so what you need is a go away and check all title blocks in dwg move as required and then run plot macro. Will see if I have time.

 

this is close done for something else

; moves all objects in pspace to 0,0 alignment
; By BIG AL
; moves all objects in pspace to 0,0 alignment

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
 (setq plotabs (cons (vla-get-name lay) plotabs))
)
(setq plottablist (acad_strlsort plotabs))
(setq len (length plottablist))
(setq oldsnap (getvar "osmode")) 
(setvar "osmode" 0)
(setq en (entsel "Pick Title Block:"))
(setq  ed (entget (car en)))
(setq K 0)
(repeat len
 (setq name (nth K plottablist))
 (princ name)
 (if (/= name "Model")
   (progn
   (setvar "ctab" name)
   (setq minxy  (getvar "extmin"))
   (setq maxxy (getvar "extmax"))
   (setq ss (ssget "_X" (list (cons 0 "INSERT")  (cons 410 name) (cons 2 (cdr (assoc 2 ed))) ) ))
   (setq n (sslength ss))
   (setq en (ssname ss 0))
   (setq xy (assoc 10 (entget en)))
 ; insertion pt   (setq xy (assoc 10 el)) 
   (setq xy (list (cadr xy)(caddr xy)))
   (command "move" "w" minxy maxxy  "" xy "0,0")
   (command "zoom" "E")
   ) ;end progn
) ; end if
(setq K (+ K 1))
(princ k)
(setq ss nil)
(setq xy nil)
) ; end repeat

(setvar "osmode" oldsnap)
(princ)

Edited December 1, 2014 by BIGAL

[vernonlee]

also, my NOOB routine with variable length

(setq l1 "100,0,0") ;sets the second point of the line
(defun c:test () 
(setvar "filedia" 0)
(setvar "cmdecho" 1)
(setvar "orthomode" 1)
(setq cl1 (getstring (strcat "\nEnter Line X, <" l1 ">: ")))
(if (= cl1 "")
    (setq cl1 l1)
    (setq l1 cl1)
)
(command "clayer" "Defpoints")

(command "celtype" "Bylayer")
(command "line" "0,0,0" l1 "" "")
(command "-array" "l" "" "p" "0,0,0" "4" "" "")
(command "zoom" "C" "0,0,0" "250")
(setvar "filedia" 1)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(princ)

) 

 

Thanks ttray33y. Another interesting lisp as well. Would prefer not to key in anything but your lisp is a keeper as well.

[vernonlee]

Why not pick block and display a offset just 2 lines of code

 

this is close done for something else

; moves all objects in pspace to 0,0 alignment
; By BIG AL
(PROMPT ".....now moving dwgs....")
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
 (setq plotabs (cons (vla-get-name lay) plotabs))
)
(setq plottablist (acad_strlsort plotabs))
(setq len (length plottablist))
(setq oldsnap (getvar "osmode")) 
(setvar "osmode" 0)
(setq en (entsel "Pick Title Block:"))
(setq K 0)
(repeat len
 (setq name (nth K plottablist))
 (princ name)
 (if (/= name "Model")
   (progn
   (setvar "ctab" name)
   (setq minxy  (getvar "extmin"))
   (setq maxxy (getvar "extmax"))
   (setq  ed (entget (car en)))
   (setq ss (ssget "_X" (list (cons 0 "INSERT")  (cons 410 name) (cons 2 (cdr (assoc 2 ed))) ) ))
   (setq n (sslength ss))
   (setq en (ssname ss 0))
   (setq xy (assoc 10 (entget en)))
 ; insertion pt   (setq xy (assoc 10 el)) 
   (setq xy (list (cadr xy)(caddr xy)))
   (command "move" "w" minxy maxxy  "" xy "0,0")
   (command "zoom" "E")
   ) ;end progn
) ; end if
(setq K (+ K 1))
(princ k)
(setq ss '()
       xy nil)
) ; end repeat

(setvar "osmode" oldsnap)
(princ)

 

If i undertood correctly the above lisp will move every thing in the paper space to 0,0,0? I tried the above code & select the title block then got the following error

 

.....now moving dwgs....Pick Title Block:Model1RFI; error: bad argument type: lentityp nil

btw how does the lisp know to what extend to capture the drawings & which point of the title block it is to suppose to move to?

 

Also to clarify, the purpose for the cross is to do a quick check to see if the title block is at 0,0,0.

[BIGAL]

Q1 extmin extmax checks the area of the drawing as it appears in a layout so will move everything in that layout including Mviews.

 

Q2 the move is based on the insert point of your Title block being 0,0 if your title block has some other point as the insertion point just change the 0,0 to the correct value.

 

Q3 will check code again I have used it previously so not sure why it did not work.

[vernonlee]

Q1 extmin extmax checks the area of the drawing as it appears in a layout so will move everything in that layout including Mviews.

Amazing

 

Q2 the move is based on the insert point of your Title block being 0,0 if your title block has some other point as the insertion point just change the 0,0 to the correct value.

Roger that

Q3 will check code again I have used it previously so not sure why it did not work.

Thanks

 

............................................

[BIGAL]

Made 1 tiny change to code above appears to be working was not resetting ss properly

[vernonlee]

Made 1 tiny change to code above appears to be working was not resetting ss properly

 

Hi BigAl.

 

Just ested it. It did move to 0 along the x axis only. The y axix did not move.

[BIGAL]

Mine tests move X & Y can you post a dwg.

[vernonlee]

Mine tests move X & Y can you post a dwg.

 

Did you change the LISP?

 

Cause I tested it again & I realised that when there are 2 or more layout tabs, it somehow not work. (the next layout tab will appear after running the command)

 

But with 1 layout tab, the title blk did move to 0,0 but there is this error:-

 

Select objects:
Specify base point or [Displacement] <Displacement>:
Specify second point or <use first point as displacement>: 0,0
Command: zoom
Specify corner of window, enter a scale factor (nX or nXP), or
[All/Center/Dynamic/Extents/Previous/Scale/Window/Object] <real time>: E
Command: 5Layout2; error: AutoCAD variable setting rejected: "ctab" "Layout2"

Btw, i base this on a fresh CAD drawing

[BIGAL]

It has to be something in your dwg need a copy posted here just did 4 layouts random location to start, works as expected moved to 0,0

[vernonlee]

It has to be something in your dwg need a copy posted here just did 4 layouts random location to start, works as expected moved to 0,0

 

ok. I will try 1 more time at home to see if it works. Else i will post a dwg here for your study.

 

Thanks Bigal