Topic: Make 3D Point from COGO Anonymous Block

[rayakmal]

I'm trying to convert COGO Anonymous blocks to 3D Points, since all insertion point of these Anonymous blocks are (0,0,0), the Points I've got from the conversion are all have coordinate (0,0,*).
Anyone can help me with this code?

Code: [Select]


(defun C:TEST ( )

   (if (setq en (car (entsel "\n. Pick one Anonymous block: ")))
     (progn
       ;;
       ;; Get list of Texts inside block
       ;;
       (setq txtlst (GET-TxtLstFromAnonBlock en))
       ;; Pick one to Process
       (if (setq idx (LM:listbox-V12 " Select Elevation Data " txtlst 2))
          (setq idx (car idx))
       )
       (princ "\n. Select Block to Convert: ")
       (setq filter '(( 0 . "INSERT")))
       (setq sset (ssget filter))

       (setq counter    (sslength sset))
       (setq idxcounter 0)

       (while sset
         (setq enm  (ssname sset 0))
         (MakeCOGOPOINT enm idx)
         (setq sset  (ssdel enm sset))
         (if (zerop (sslength sset))
            (setq sset nil)
         );end if
         (setq idxcounter (+ idxcounter 1))
       );end of while

       (if (> counter 0)
         (princ (strcat "\n. Anonymous Blocks: "        (itoa counter)
                        " selected, " (itoa idxcounter)
                        " Processed"
                )
         )
       );end if

     );end progn
   );end if
   (setmode *mod2)
   (OldErrTrap)
   (princ)
)

(defun dxf-code (code enm /) (cdr (assoc code (entget enm))))

(defun GET-TxtLstFromAnonBlock (en)
  (if (AND (= (dxf-code 0 en) "INSERT") ;Check if it's an inserted block reference
           (= "*U" (substr (dxf-code 2 en) 1 2))
      )
    (progn
      (setq blkname (dxf-code 2 en)) ;Get the block's name from the Insert's DXF data
      (setq a  (tblobjname "BLOCK" blkname))

      (setq txlst '())
      (setq data (entget a))
      (while a
          (if (setq a (entnext a))
            (progn
               (setq etype (cdr (assoc 0 (entget a))))
               (if (= etype "MTEXT")
                   (progn
                      (setq txt (dxf-code 1 a))
                      (setq txlst (append txlst (list txt)))
                   );end progn
               );end if
            );end progn
          );end if
      );end while
     );end progn
  );end if
  txlst
)

(defun MakeCOGOPOINT ( en idx / blkname bn)

  (if (AND (= (dxf-code 0 en) "INSERT") ;Check if it's an inserted block reference
           (= "*U" (substr (dxf-code 2 en) 1 2))
      )
    (progn
      (setq blkname (dxf-code 2  en)) ;Get the block's name from the Insert's DXF data
      (setq ipt     (dxf-code 10 en))
      (setq a    (tblobjname "BLOCK" blkname))
      (setq data (entget a))

      (setq txlst '())
      (while a
          (if (setq a (entnext a))
            (progn
               (setq etype (cdr (assoc 0 (entget a))))
               (if (= etype "MTEXT")
                   (progn
                      (setq txt (dxf-code 1 a))
                      (setq txlst (append txlst (list txt)))
                   );end progn
               );end if
            );end progn
          );end if
       );end of while
       (setq txtelev (nth idx txlst))
       (if (Setq elev (distof txtelev))
          (command "Point" (mapcar '+ (2D-Of ipt)  (list 0.0 0.0 elev)))
       )
     );end progn
   );end if
);end defun

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil

(defun LM:listbox-V12 ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=25;}spacer;ok_cancel;}"       ;;; TINGGI ASALNYA 15
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)



[BIGAL]

If its a CIV3D cogo point use this

Code: [Select]

(setq obj (vlax-ename->vla-object  (car (entsel))))
 ; vl 3d point convert to plain lisp
  (setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj "Location"))))

[rayakmal]

If its a CIV3D cogo point use this

Code: [Select]

(setq obj (vlax-ename->vla-object  (car (entsel))))
 ; vl 3d point convert to plain lisp
  (setq pt1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj "Location"))))

Tried it but it returned error:

; error: ActiveX Server returned the error: unknown name: Location

[It's Alive!]

try Position

[rayakmal]

try Position

The same result; ; error: ActiveX Server returned the error: unknown name: Position

[It's Alive!]

InsertionPoint

[rayakmal]

InsertionPoint

It works but when I selected the anonymous blocks they returned (0,0,0). These are not coordinates that I'm looking for.

[HOSNEYALAA]

 can you see this
http://www.theswamp.org/index.php?topic=22206.0;all

Code: [Select]


;; Entmatrix
;; Returns a list which first item is the 3X3 tranformation matrix and second item
;; the insertion point of a block refernce in its owner (space or block definition)
(defun EntMatrix (ename / elst ang norm)
  (setq elst (entget ename)
ang  (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
  )
  (list
    (mxm
      (mapcar (function (lambda (v) (trans v 0 norm T)))
      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
      )
      (mxm
(list (list (cos ang) (- (sin ang)) 0.0)
      (list (sin ang) (cos ang) 0.0)
      '(0.0 0.0 1.0)
)
(list (list (cdr (assoc 41 elst)) 0.0 0.0)
      (list 0.0 (cdr (assoc 42 elst)) 0.0)
      (list 0.0 0.0 (cdr (assoc 43 elst)))
)
      )
    )
    (trans (cdr (assoc 10 elst)) norm 0)
  )
)

;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins / blk ent lst)
  (setq blk (tblsearch "BLOCK" (cdr (assoc 2 (entget ref)))))
  (setq ent (cdr (assoc -2 blk)))
  (while ent
    (setq elst (entget ent)
  typ  (cdr (assoc 0 elst))
    )
    (cond
      ((= "LINE" typ)
       (setq lst (cons (list typ
     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
     (mapcar '+ ins (mxv mat (cdr (assoc 11 elst))))
       )
       lst
)
       )
      )
      ((member typ '("POINT" "TEXT"))
       (setq lst (cons (list typ
     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
       )
       lst
)
       )
      )
      ((= "INSERT" typ)
       (setq nent (EntMatrix ent))
       (setq lst
      (append
lst
(Blk2Coord ent
   (mxm  mat (car nent))
   (mapcar '+ ins (mxv mat (cadr nent)))
)
      )
       )
      )
      (T nil)
    )
    (setq ent (entnext ent))
  )
  (cons (list (cdr (assoc 2 blk)) ins) lst)
)

;; Transpose a matrix Doug Wilson
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
  m
  )
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)

;; Main function

(defun c:test (/ ss n ent mtx lst)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq n (sslength ss))
      (setq ent (ssname ss (setq n (1- n)))
    mtx (EntMatrix ent)
    lst (append (Blk2Coord ent (car mtx) (cadr mtx)) lst)
      )
    )
  )
  (mapcar 'print lst)
  (textscr)
  (princ)
)


[BIGAL]

When people start guessing what is object a sample dwg is needed then can work out what it really is.

Use dumpit to see what it returns.

[It's Alive!]

When people start guessing what is object a sample dwg is needed then can work out what it really is.

Use dumpit to see what it returns.

LOL, yeah, I guessed after your guess, then I went and read the docs 

[rayakmal]

Thanks. problem solved

can you see this
http://www.theswamp.org/index.php?topic=22206.0;all

Code: [Select]


;; Entmatrix
;; Returns a list which first item is the 3X3 tranformation matrix and second item
;; the insertion point of a block refernce in its owner (space or block definition)
(defun EntMatrix (ename / elst ang norm)
  (setq elst (entget ename)
ang  (cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
  )
  (list
    (mxm
      (mapcar (function (lambda (v) (trans v 0 norm T)))
      '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
      )
      (mxm
(list (list (cos ang) (- (sin ang)) 0.0)
      (list (sin ang) (cos ang) 0.0)
      '(0.0 0.0 1.0)
)
(list (list (cdr (assoc 41 elst)) 0.0 0.0)
      (list 0.0 (cdr (assoc 42 elst)) 0.0)
      (list 0.0 0.0 (cdr (assoc 43 elst)))
)
      )
    )
    (trans (cdr (assoc 10 elst)) norm 0)
  )
)

;; Blk2Coord
;; Returns a list of a block reference entities coordinates
(defun Blk2Coord (ref mat ins / blk ent lst)
  (setq blk (tblsearch "BLOCK" (cdr (assoc 2 (entget ref)))))
  (setq ent (cdr (assoc -2 blk)))
  (while ent
    (setq elst (entget ent)
  typ  (cdr (assoc 0 elst))
    )
    (cond
      ((= "LINE" typ)
       (setq lst (cons (list typ
     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
     (mapcar '+ ins (mxv mat (cdr (assoc 11 elst))))
       )
       lst
)
       )
      )
      ((member typ '("POINT" "TEXT"))
       (setq lst (cons (list typ
     (mapcar '+ ins (mxv mat (cdr (assoc 10 elst))))
       )
       lst
)
       )
      )
      ((= "INSERT" typ)
       (setq nent (EntMatrix ent))
       (setq lst
      (append
lst
(Blk2Coord ent
   (mxm  mat (car nent))
   (mapcar '+ ins (mxv mat (cadr nent)))
)
      )
       )
      )
      (T nil)
    )
    (setq ent (entnext ent))
  )
  (cons (list (cdr (assoc 2 blk)) ins) lst)
)

;; Transpose a matrix Doug Wilson
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)

;; Apply a transformation matrix to a vector by Vladimir Nesterovsky
(defun mxv (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
  m
  )
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)

;; Main function

(defun c:test (/ ss n ent mtx lst)
  (if (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq n (sslength ss))
      (setq ent (ssname ss (setq n (1- n)))
    mtx (EntMatrix ent)
    lst (append (Blk2Coord ent (car mtx) (cadr mtx)) lst)
      )
    )
  )
  (mapcar 'print lst)
  (textscr)
  (princ)
)