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?
(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
)