Author Topic: Insert Blocks on Grid - need ucs help  (Read 10205 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Insert Blocks on Grid - need ucs help
« on: January 15, 2004, 12:39:47 PM »
I'm a ucs dummy.  :(
I am finishing this routine but it won't work if the ucs is not world.
Why is that? & what is the fix?

Revision 1
Revision 2
Code: [Select]

;;; ---------------------------------------------------------------------------
;;;
;;;           Grid_Block_Insert.lsp
;;;      Created by C. Alan Butler
;;;
;;;        Version 1.1  01/15/2004
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; FUNCTION
;;;   Grid Block Insert LISP will insert a block at all intersections
;;;   of lines and/or circles on a given layer
;;;   block insert angle is determined by the line at the insert point
;;;    or radial of the circle at the insert point
;;;
;;;
;;; USAGE
;;;     (Grid_Block_Insert
;;;       "S-Grid"    ;; change to your layer name
;;;        "B-Col"    ;; change to your block name
;;;             36    ;; Block Scale X
;;;             36    ;; Block Scale Y
;;;            nil    ;; Block Rotation Angle in degrees
;;;     )
;;;   if Block Rotation is nil the routine uses the grid lines
;;;   to determin the angle of rotation else use the user angle
;;; ---------------------------------------------------------------------------

(defun grid_block_insert (layname   blkname   blksclx   blkscly
                          blkrota   /         ss1       pts
                          ss2       pt        enttype   enttype1
                          enttype2  blkrot1   blkrot2   cirlast
                          ss3       cnt       rotateusr blkcnt
                          pksize    *error*
                         )
  ;;-----------------------------------------------------------
  ;;                  Local Functions                          
  ;;-----------------------------------------------------------
;;;;;;;;;;;;;;;BEGIN ERROR HANDLING FUNCTION;;;;;;;;;;;;;;;
  (defun *error* (msg) ; error function
    (if
      (not
        (member
          msg
          '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; endif

    (command "Change" ss1 "" "P" "LT" "ByLayer" "")
    (command "Zoom" "P")
    (command "UCS" "Previous")
    (setvar "CMDECHO" usercmd)
    (setvar "OSMODE" useros)
    (command "undo" "end")
    (prompt "\nResetting System Variables... ")
    (princ)
  ) ;end error function
;;;;;;;;;;;;;;;END ERROR HANDLING FUNCTION;;;;;;;;;;;;;;;

  (defun get_all_lines_as_ss ()
    (ssget "X" (list (cons 0 "LINE,CIRCLE,ARC") (cons 8 layname)))
  )
  (defun rtod (r)
    (* 180.0 (/ r pi))
  )
  (defun lineang (ent)
    (rtod (angle (cdr (assoc 10 ent)) (cdr (assoc 11 ent))))
  )

;;;  ============================================================
  (defun check_for_block (rot / blkfound)
    (if blkpksz
      (progn
        (setq ss3 ;; see if column is already there
                  (ssget "C"
                         (polar pt 3.9 blkpksz)
                         (polar pt 0.8 blkpksz)
                         '((0 . "INSERT"))
                  )
        )
        (if ss3 ; block found so test it
          (progn
            (setq cnt      (sslength ss3)
                  blkfound nil
            )
            (repeat cnt
              (if ; the block is one we inserted flag yes
                (= (cdr (assoc 2 (entget (ssname ss3 (1- cnt)))))
                   blkname
                )
                 (setq blkfound t)
              )
              (setq cnt (1- cnt))
            )
            (if blkfound ; print a warning
              (princ "\nWarning, column already at this intersection.")
              (command ".-insert" blkname pt blksclx blkscly rot)
            )
          )
         blkfound
        )
      )
      (progn ; else no blocks inserted yet
        (command ".-insert" blkname pt blksclx blkscly rot)
        ;; get the size of the block
        (vla-GetBoundingBox (vlax-ename->vla-object (entlast)) 'll 'ur)
        (setq ptll (vlax-safearray->list ll)
              ptur (vlax-safearray->list ur)
              bWidth   (/ (- (car ptur)(car ptll)))
              bHeigth  (/ (- (cadr ptur)(cadr ptll)))
              blkpksz    (/(min bWidth bHeight)2) ; select box size / 2
              ;; CAB
        )
      )
    )
  )
;;;  ============================================================

  (defun insertblock ()
    (setq blkcnt (1+ blkcnt)) ; increment block count
    (if rotateusr ; user set angle
      (check_for_block rotateusr) ; insert block if none there
      ;; else calculate rotation angle
      (progn
        (if (> (sslength ss2) 2)
          (progn
            (setq cnt      (sslength ss2)
                  blkrota  360
                  enttype1 ""
            )
            (repeat cnt
              ;; get all LINE angles
              (if (= (cdr (assoc 0 (entget (ssname ss2 (1- cnt)))))
                     "LINE"
                  )
                (progn ;;  Get the smallest angle
                       (setq
                         blkrot1 (lineang (entget (ssname ss2 (1- cnt))))
                       )
                       (setq blkrot1 (if (= blkrot1 360)
                                       0
                                       blkrot1
                                     )
                       )
                       (setq blkrot1 (if (> blkrot1 180)
                                       (- blkrot1 180)
                                       blkrot1
                                     )
                       )
                       (setq blkrota (min blkrot1 blkrota))
                )
              ) ; endif
              (setq cnt (1- cnt))
            )

          ) ; end progn
          ;; else get 2 objects at the intersection
          (setq curent1  (entget (ssname ss2 0))
                enttype1 (cdr (assoc 0 curent1))
                curent2  (entget (ssname ss2 1))
                enttype2 (cdr (assoc 0 curent2))
          )
        ) ; endif (> (sslength ss2)2)
        (cond
          ;;  flag set from multiple objects
          ((= enttype1 "")
           (princ) ; nothing to do, BlkRota is set
          )
          ;; if 2 lines use the least angle for block rotation
          ((and (= enttype1 "LINE") (= enttype2 "LINE"))
           (setq blkrot1 (lineang curent1))
           (setq blkrot2 (lineang curent2))
           (setq blkrota (min blkrot1 blkrot2))
          )
          ;; if line and circle/arc use the lines angle for rotation
          ((or (= enttype1 "LINE") (= enttype2 "LINE"))
           (if (= enttype1 "LINE")
             (setq blkrota (lineang curent1))
             (setq blkrota (lineang curent2))
           )
          )
          (t
           ;; Circles or arcs & no lines, use the center of the first one found
           ;; for rotation & keep using it as long as it is one of the objects
           (setq blkrot1 (cdr (assoc 10 curent1))) ; circle center
           (setq blkrot2 (cdr (assoc 10 curent2)))
           (setq cirlast
                  (if (equal cirlast blkrot1 0.001)
                    blkrot1
                    blkrot2
                  )
           )
           (setq blkrota (rtod (angle pt cirlast)))
          )
        ) ; end cond
        (check_for_block blkrota) ; insert block if none there
      ) ; end progn
    ) ; endif RotateUsr
  ) ; end defun

  (vl-load-com)
  ;;-----------------------------------------------
  ;; Function by Bill Kramer modified by CAB
  ;; Find all intersections between objects in
  ;; the selection set SS. Return list of points found
  ;; BEGIN
  (defun get_all_inters_in_ss (ss / ssl ;length of SS
                               pts ;returning list
                               aobj1 ;Object 1
                               aobj2 ;Object 2
                               n1 ;Loop counter
                               n2 ;Loop counter
                               ipts ;intersects
)
    (setq n1  0 ;index for outer loop
          ssl (sslength ss)
    )
 ; Outer loop, first through second to last
    (repeat ssl ; Get object 1, convert to VLA object type
      (setq aobj1 (vlax-ename->vla-object (ssname ss n1))
            n2    (1+ n1)
      ) ;index for inner loop
 ; Inner loop, go through remaining objects
      (while (< n2 ssl) ; Get object 2, convert to VLA object
        (setq aobj2 (vlax-ename->vla-object (ssname ss n2))
 ; Find intersections of Objects
              ipts  (vlax-variant-value (vla-intersectwith aobj1 aobj2 0))
        )
 ; Variant array has values?
        (if (> (vlax-safearray-get-u-bound ipts 1) 0)
          (progn ;array holds values, convert it
            (setq ipts ;to a list.
                   (vlax-safearray->list ipts)
            )
 ;Loop through list constructing points
            (repeat (/ (length ipts) 3)
              (setq pts  (cons (list (car ipts) (cadr ipts) (caddr ipts))
                               pts
                         )
                    ipts (cdddr ipts)
              )
            )
          )
        )
        (setq n2 (1+ n2))
      ) ;inner loop end
      (setq n1 (1+ n1))
    ) ;outer loop end
    pts
  ) ;return list of points found
  ;; END



;;;  ---------------------------------------------
;;;  --------   Start of Routine   ---------------
;;;  ---------------------------------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setq useros (getvar "osmode"))
  (prompt "\nBegin processing.")
  (setq blkname (strcase blkname)) ; force upper case
  (setq blkcnt 0
        ;; number of blks inserted
        pksize
         5 ; 1/2 pick box size to get objects at intersection
        blkpksz nil ; Pick box size to get block, routine will set this
  )
  (if (or (= (type blkrota) 'real) (= (type blkrota) 'int))
 ; pre set angle error check
    (setq rotateusr (if (and (>= blkrota 0) (<= blkrota 360))
                      blkrota
                      nil
                    )
    )
    (setq rotateusr nil) ; flag to allow rotate based on objects
  )
  (if (setq ss1 (get_all_lines_as_ss))
    (progn
      (setq pts (get_all_inters_in_ss ss1))
      (command "undo" "begin")
      (setvar "osmode" 0)
      (if (/= (getvar "TILEMODE") 1)
        (command "MODEL")
      )
      (command "UCS" "World")
      ;; added for proper selection of intersetions
      (command "Zoom" "E")
      (command "Change" ss1 "" "P" "LT" "continuous" "")
      ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
      (if (not (tblsearch "block" blkname))
        (progn
          (alert (strcat "\n\n\tBlock "
                         blkname
                         " is missing from drawing\t\t\n\n"
                 )
          )
          (quit)
        )
      )

      (foreach pt pts
        (setq pt (trans pt 1 0)) ; adjust for non-World UCS
        ;; step through the intersections
        (setq ss2
               ;;  select objects at that intersection
               (ssget "C"
                      (polar pt 3.9 pksize)
                      (polar pt 0.8 pksize)
                      (list (cons 0 "LINE,CIRCLE,ARC") (cons 8 layname))
               )
        )
 ;test(command "LINE"  (polar pt 3.9 10)(polar pt 0.8 10) "")
        (if ss2
          (progn
            (setq ssl (sslength ss2))
            (cond
              ((= ssl 1)
               (princ "\nError, only one object found.  ")
               (command "circle" pt 10)
               ;; flag error point
              )

              ((> ssl 2)
               ;; there will be >1 point associated with this intersection
               (setq ss3 ;; see if column is already there
                         (ssget "C"
                                (polar pt 3.9 pksize)
                                (polar pt 0.8 pksize)
                                '((0 . "INSERT"))
                         )
               )
               (if ss3 ; block found so test it
                 (progn
                   (setq cnt      (sslength ss3)
                         blkfound nil
                   )
                   (repeat cnt
                     (if ; the block is one we inserted flag yes
                       (= (cdr (assoc 2 (entget (ssname ss3 (1- cnt)))))
                          blkname
                       )
                        (setq blkfound t)
                     )
                     (setq cnt (1- cnt))
                   )
                   (if blkfound ; print a warning
                     (princ
                       "\nWarning, column already at this intersection."
                     )
                     (insertblock)
 ; else no matching block so insert one
                   )
                 ) ; progn
                 (insertblock) ; no block found so insert it
               ) ; endif ss3
              ) ; endcond ssL > 2

              (t
               ;; ok to process
               (insertblock)
              )
            ) ; end cond
          ) ;end progn
          (progn ;;  this occurs if selection missed objects at the intersection
                 (princ "\nError, point missed angle referance.  ")
                 (princ pt)
                 (command "circle" pt 10 "circle" pt 20)
          )
        ) ; end  if ss2
      ) ; endfor
      (*error* "") ; exit via error routine to reset variables
    ) ; end progn
    (alert (strcat "\n\n\tNo objects on layer " layname "\t\t\n\n"))
  ) ; endif
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
  (princ)
  (if blkcnt blkcnt 0); return number of blocks inserted
) ; end defun
;;  End of File  ================================================

;;;================================
;;;    Call to function example    
;;;================================
;;;   if Block Rotation is nil the routine uses the grid lines
;;;   to determin the angle of rotation else use the user angle
;;;
(defun c:gbi (/ blks)
  (setq blks
         (grid_block_insert
           "S-Grid" ; change to your layer name
           "B-Col" ; change to your block name
           36 ; Block Scale X
           36 ; Block Scale Y
           nil ; Block Rotation Angle in degrees
)
  )
  (if (> blks 0)
    (alert (strcat "\n\n\t"
                   (itoa blks)
                   "  \""
                   "B-Col"
                   "\" blocks have been inserted!\t\t\n\n"
           )
    )
    (alert "\n\n\t No Insertions!\t\t\n\n")
  ) ; endif
  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Insert Blocks on Grid - need ucs help
« Reply #1 on: January 15, 2004, 01:46:22 PM »
Ok I am not going to pick apart the code at the moment... maybe someone else can, but this will put you in the right direction .....

Whenever you are in a different UCS than World, the commands used to create objects put them in the current UCS. Now, if you retrieve the point data from an object through it's entity list (assoc 10 ent) or (assoc 11 ent) you will get world coordinates.

Then later you use a command (rather than lisp) to create or modify an object (command "-insert" ...) it will use the current UCS. So how to fix it is use the lisp function TRANS ...

So ..
wherever you have gathered a point using entity lists treat it as WORLD and convert it to USER when using a command.
(setq USER(trans WORLD 0 1))
If you are using (getpoint) it will return USER so treat it as USER and no conversion is needed when using a command.
If you are using (getpoint) and you are creating or modifying entites with (entmod ent) or (entmake ent) you have to do it in reverse...
(setq WORLD (trans USER) 1 0))

There are a couple of other examples but it can get kinda convoluted.

Suffice to say if you get your points from existing entities and you are using a command to modify or create you need to convert to the correct UCS.

So to that end...
(getpoint) returns USER
(assoc nn xxx) returns WORLD
(command .....) uses USER
(entmod xxx) uses WORLD
(entmake xxx) uses WORLD

So using that scenario make sure you convert before you use...

Syntax ...
(TRANS POINT FROM_UCS TO_UCS)

For more info see the AutoLISP reference but this should get you started...
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

SMadsen

  • Guest
Insert Blocks on Grid - need ucs help
« Reply #2 on: January 15, 2004, 02:04:48 PM »
Quote from: Keith
(assoc nn xxx) returns WORLD

Just to add a bit: there are some exceptions to this. One is that a few objects are expressed in OCS - especially nested objects. Another is when the extrusion vector can be non-planar with WCS, for which a typical situation is a circle or arc drawn in a rotated UCS. But also in that case, TRANS have the ability to convert simply by supplying the entity itself. For example:

(setq ent (entlast) cpt (cdr (assoc 10 (entget ent))))
(trans cpt ent 0)

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Insert Blocks on Grid - need ucs help
« Reply #3 on: January 15, 2004, 02:12:18 PM »
Stig....You are indeed correct thanks for adding that clarification
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Insert Blocks on Grid - need ucs help
« Reply #4 on: January 15, 2004, 02:19:19 PM »
Let me see if I got it straight.
My routine gathers all point data via lisp & vlisp so the data is world.
the blocks are inserted via the "command" so the point must be translated.

Is it ok to use the trans command if you are in world and not a user coor system?
That is to say there is no translation taking place but the command is there.

So change this:
Code: [Select]
(command ".-insert" BlkName pt BlkSclx BlkScly RotateUsr)
to this:
Code: [Select]
(command ".-insert" BlkName (trans pt 1 0) BlkSclx BlkScly RotateUsr)

and change this:
(command "circle" pt 10)
to this:
(command "circle" (trans pt 1 0) 10)

This will have to be translated too:
Code: [Select]

      (setq ss3 ;; see if column is already there
(ssget "C"
(polar pt 3.9 10)
(polar pt 0.8 10)
'((0 . "INSERT"))
)
      )


I see that because i have one reference pt it would be better to :
(setq pt (trans pt 1 0)) as soon as pt is established
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Insert Blocks on Grid - need ucs help
« Reply #5 on: January 15, 2004, 02:40:58 PM »
You have the right idea..

And yes for the most part it is ok to trans a coord from user to world if the UCS is set to world ...

Why???

Because when you are in WCS, UCS = WCS

Therefore
(trans '(1 0 0) 1 0)  returns (1 0 0) when UCS = WCS
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Insert Blocks on Grid - need ucs help
« Reply #6 on: January 15, 2004, 02:55:19 PM »
I use this button to work on the right side elevation

^C^Cdview;;tw;-90;;_ucs;w;_ucs;z;90;

This puts the right side of the house upright and the xy axis
is correct for drawing on it.

When I used this on my test grid the insertion points were
located at 180 deg rotated from actual.

example
p=original points
x= inserted point
0 = 0,0,0
Code: [Select]

....x
....x
....x
......0
........p
........p
........p
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

SMadsen

  • Guest
Insert Blocks on Grid - need ucs help
« Reply #7 on: January 15, 2004, 03:00:47 PM »
CAB, I think the best bet is to switch to WCS while running the routine and switch it back when you're done (preferably in an *error* function).
There are alot of transformations to consider in your code. To name a few: 1. Circles 2. Inserts 3. Intersection points.
Not only do you have to displace points, but also planes.

I would simply call (command "UCS" "World") at the start and (command "UCS" "Previous") at the end. Unless, of course, your gridlines are non-planar to WCS.

SMadsen

  • Guest
Insert Blocks on Grid - need ucs help
« Reply #8 on: January 15, 2004, 03:02:19 PM »
Oh, seems your gridlines are not plane with WCS.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Insert Blocks on Grid - need ucs help
« Reply #9 on: January 15, 2004, 03:07:50 PM »
I'll try this:
Quote
(command "UCS" "World") at the start and (command "UCS" "Previous")


not sure what you are refering to "in plane with WCS"

The z values are all zero. or am i lost again? :)

CAB
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

SMadsen

  • Guest
Insert Blocks on Grid - need ucs help
« Reply #10 on: January 15, 2004, 03:20:55 PM »
In plane with WCS would mean that extrusion vectors are coinciding with the WCS. It has little or nothing to do with Z values.
You can have objects that have Z=0.0 in WCS, e.g. a circle with center point in WCS 0,0,0 - but they need not be planar with the WCS.

If I understand you correctly, you twist the UCS 90 degrees around Z to get an elevation of a building? That would mean the elevation is not planar with the WCS.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Insert Blocks on Grid - need ucs help
« Reply #11 on: January 15, 2004, 03:25:01 PM »
Quote

The z values are all zero. or am i lost again


BUT
Your UCS is -90 degrees out from World.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Insert Blocks on Grid - need ucs help
« Reply #12 on: January 15, 2004, 03:33:47 PM »
OK I think i got it working. I revisd the code above but here is a  snapshot.

I need some more time to digest the UCSWCSPlaner thingie. :)

Code: [Select]


;;;;;;;;;;;;;;;BEGIN ERROR HANDLING FUNCTION;;;;;;;;;;;;;;;
  (defun *error* (msg) ; error function
    (if
      (not
(member
 msg
 '("console break" "Function cancelled" "quit / exit abort" "")
)
      )
       (princ (strcat "\nError: " msg))
    ) ; endif

    (command "Change" ss1 "" "P" "LT" "ByLayer" "")
    (command "Zoom" "P")
    (command "UCS" "Previous")
    (setvar "CMDECHO" usercmd)
    (setvar "OSMODE" useros)
    (command "undo" "end")
    (prompt "\nResetting System Variables... ")
    (princ)
  ) ;end error function
;;;;;;;;;;;;;;;END ERROR HANDLING FUNCTION;;;;;;;;;;;;;;;



      (if (/= (getvar "TILEMODE") 1)
(command "MODEL")
      )
      (command "UCS" "World")
      ;; added for proper selection of intersetions
      (command "Zoom" "E")
      (command "Change" ss1 "" "P" "LT" "continuous" "")
      ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

     <code body here>

      (foreach PT PTS
(setq pt (trans pt 1 0)) ; adjust for non-World UCS


    <end of code>
    (*error* "")
) ; end defun
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

SMadsen

  • Guest
Insert Blocks on Grid - need ucs help
« Reply #13 on: January 15, 2004, 03:54:26 PM »
I'm not so sure about setting the UCS to WCS if you say that the gridlines are rotated 90 degrees from WCS (but I haven't studied your code in detail).

Just a note: (foreach PT PTS (setq pt (trans pt 1 0))) will not affect PTS directly. You'll have to stuff the new points back into PTS. For example:

(setq PTS (mapcar (function (lambda (pt)(trans pt 1 0))) PTS))

or

(foreach PT PTS (setq newPTS (cons (trans pt 1 0) newPTS)))
(setq PTS newPTS)

SMadsen

  • Guest
Insert Blocks on Grid - need ucs help
« Reply #14 on: January 15, 2004, 03:57:42 PM »
Oh, sorry. Didn't see that the code above use the points while in FOREACH. Disregard that last note.