Community
try
;; ; ; Jeff mishler
;;borrowed FindNumbers function as posted by MP to the Swamp
(defun FindNumbers (String / Distil NumList Result)
(defun Distil (lst)
(while (eq 46 (car lst)) (setq lst (cdr lst)))
(setq lst (reverse lst))
(while (eq 46 (car lst)) (setq lst (cdr lst)))
(reverse lst)
)
(foreach Code
(reverse
(mapcar
'(lambda (Code)
(if (or (< 47 Code 58) (eq 46 Code))
Code
32
)
)
(vl-string->list String)
)
)
(if (eq 32 Code)
(if NumList
(setq
Result (cons NumList Result)
NumList nil
)
)
(setq NumList (cons Code NumList))
)
)
(mapcar 'vl-list->string
(vl-remove-if
'null
(mapcar 'Distil
(if NumList
(cons NumList Result)
Result
)
)
)
)
)
;; ; ; Jeff mishler
(defun c:TESTATT (/ *ACAD* ATTS BLK BLKSOBJ C3D C3DDOC CODE DOC ELEV ENAME ENT IDX OBJ OCOGO OLDSTR PNTNUMS PNTS PT SPC SS)
(setvar "CMDECHO" 0)
(command "-osnap" "off")
;; ; ; Jeff mishler
(setq *acad* (vlax-get-acad-object))
(setq C3D (strcat "HKEY_LOCAL_MACHINE\\"
(if vlax-user-product-key
(vlax-user-product-key)
(vlax-product-key)
)
)
C3D (vl-registry-read C3D "Release")
C3D (substr
C3D
1
(vl-string-search "." C3D (+ (vl-string-search "." C3D) 1))
)
C3D (vla-getinterfaceobject
*acad*
(strcat "AeccXUiLand.AeccApplication." C3D)
)
)
(setq C3Ddoc (vla-get-activedocument C3D))
(setq pnts (vlax-get C3Ddoc 'points))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq blksObj (vla-get-blocks doc))
(vla-endundomark doc)
(vla-startundomark doc)
(setq spc (vla-get-modelspace doc))
;;; (setq ss (ssget '((0 . "INSERT") )))
;;; (setq ss (ssget "x" '((0 . "INSERT") (66 . 1))))
(if (setq ss (ssget '((0 . "INSERT") )))
(progn
(setq idx -1)
(while (setq ent (ssname ss (setq idx (1+ idx))))
(setq atts (vlax-invoke
(setq blk (vlax-ename->vla-object ent))
'getattributes
)
)
(if atts
(progn
(if (= oldstr nil)
(SETQ oldstr (CAR(LM:listbox "Select an Item" (MAPCAR '(lambda (x)(vlax-get x 'tagstring)) atts) 1)))
)
(setq pt (vlax-get blk 'insertionpoint))
;;; (vla-put-layer c3dPt (vla-get-layer blk))
(foreach att atts
;;; (setq att (CADDR atts))
(cond
(
(eq (vla-get-tagstring att) oldstr)
(setq elev (findnumbers (vla-get-textstring att)))
(if elev
(progn
(setq ename (list (car pt) (cadr pt) (atof (car elev))))
(setq oCogo(vlax-invoke pnts 'add ename))
(vlax-put oCogo 'rotation (vla-get-rotation blk))
(setq pntnums (vlax-get oCogo 'number))
(vla-put-NAME oCogo (strcat "EXPLODE CIVIL POINT & " (itoa pntnums)));NAME NETWORK;NAME NETWORK
(vla-put-description oCogo "CONVERT"); NAME MANHOLE
(vlax-put-property oCogo 'Style (strcat "Benchmark"))
(vlax-put-property oCogo 'LabelStyle "Elevation Only")
)
)
)
)
)
);(progn
(progn
(setq obj (vlax-ename->vla-object ent))
(setq pt (vlax-get obj 'insertionpoint))
(setq ename (list (car pt) (cadr pt) (GetLevel (vla-get-name obj) blksObj)))
(setq oCogo(vlax-invoke pnts 'add ename))
(setq pntnums (vlax-get oCogo 'number))
(vla-put-NAME oCogo (strcat "EXPLODE CIVIL POINT & " (itoa pntnums)));NAME NETWORK;NAME NETWORK
(vla-put-description oCogo "CONVERT"); NAME MANHOLE
(vlax-put-property oCogo 'Style (strcat "Benchmark"))
(vlax-put-property oCogo 'LabelStyle "Elevation Only")
)
);IF
);(progn
(princ
"\nEagle Point points have been converted to Civil 3D points."
)
);(progn
);IF
(vlax-release-object c3d)
(command "_undo" "_end")
(setvar "CMDECHO" 1)
(princ)
(princ)
);;END
;; Roy_043
(defun GetLevel (nme blksObj / out)
(vlax-for obj (vla-item blksObj nme)
(cond
(out)
;;; ((/= "V-NODE-TEXT" (strcase (vla-get-layer obj)))
;;; nil
;;; )
((= "AcDbBlockReference" (vla-get-objectname obj))
(setq out (GetLevel (vla-get-name obj) blksObj))
)
((not (vlax-property-available-p obj 'textstring))
nil
)
((wcmatch (vla-get-textstring obj) "*#.#*")
(setq out (last (LM:parsenumbers (vla-get-textstring obj))))
)
)
)
)
;; Parse Numbers - Lee Mac
;; Parses a list of numerical values from a supplied string.
(defun LM:parsenumbers ( str )
( (lambda ( l )
(read
(strcat "("
(vl-list->string
(mapcar
'(lambda ( a b c )
(if (or (< 47 b 58)
(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
(and (= 46 b) (< 47 a 58) (< 47 c 58))
)
b 32
)
)
(cons nil l) l (append (cdr l) '(()))
)
)
")"
)
)
)
(vl-string->list str)
)
)
;;-----------------------=={ List Box }==---------------------;;
;; ;;
;; Displays a List Box allowing the user to make a selection ;;
;; from the supplied data. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; title - List Box Dialog title ;;
;; data - List of Strings to display in the List Box ;;
;; multiple - Boolean flag to determine whether the user ;;
;; may select multiple items (T=Allow Multiple) ;;
;;------------------------------------------------------------;;
;; Returns: List of selected items, else nil. ;;
;;------------------------------------------------------------;;
(defun LM:ListBox ( title data multiple / file tmp dch return )
;; © Lee Mac 2011
(cond
(
(not
(and (setq file (open (setq tmp (vl-filename-mktemp nil nil ".dcl")) "w"))
(write-line
(strcat "listbox : dialog { label = \"" title
"\"; spacer; : list_box { key = \"list\"; multiple_select = "
(if multiple "true" "false") "; } spacer; ok_cancel;}"
)
file
)
(not (close file)) (< 0 (setq dch (load_dialog tmp))) (new_dialog "listbox" dch)
)
)
)
(
t
(start_list "list")
(mapcar 'add_list data) (end_list)
(setq return (set_tile "list" "0"))
(action_tile "list" "(setq return $value)")
(setq return
(if (= 1 (start_dialog))
(mapcar '(lambda ( x ) (nth x data)) (read (strcat "(" return ")")))
)
)
)
)
(if (< 0 dch) (unload_dialog dch))
(if (setq tmp (findfile tmp)) (vl-file-delete tmp))
return
)
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
