Code Red > AutoLISP (Vanilla / Visual)

Make 3D Point from COGO Anonymous Block

(1/3) > >>

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


--- End code ---

BIGAL:
If its a CIV3D cogo point use this


--- Code: ---(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"))))
--- End code ---

rayakmal:

--- Quote from: BIGAL on April 26, 2024, 07:04:01 PM ---If its a CIV3D cogo point use this


--- Code: ---(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"))))
--- End code ---

--- End quote ---

Tried it but it returned error:

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

It's Alive!:
try Position

rayakmal:

--- Quote from: It's Alive! on April 29, 2024, 03:54:59 AM ---try Position

--- End quote ---

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

Navigation

[0] Message Index

[#] Next page