If possible, help with a small change

[hosneyalaa]

Sorry English is not good

Hello all  AND  Roy_043
If possible, help with a small change
In the LISP
By choosing the type that contains the height
He did not succeed with the change

 

I have a reference block containing
1. number
2 - height
3. Description

;;https://www.cadtutor.net/forum/topic/66770-help-for-creating-a-point-from-reference-block/
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun GetLevel (nme blksObj oldtxtstr / out)
  (vlax-for obj (vla-item blksObj nme)
    (cond
      (out);1
      ((/= "V-NODE-TEXT" (strcase (vla-get-layer obj)))
        nil
      );2
      ((= "AcDbBlockReference" (vla-get-objectname obj))
        (setq out (GetLevel (vla-get-name obj) blksObj))
      );3
      ((not (vlax-property-available-p obj 'textstring))
        nil
      );4
      ((wcmatch (vla-get-textstring obj) (strcat "*"oldtxtstr"*"))
        (setq out (vla-get-textstring obj))
      );5
    );COND
  )
)

(defun c:CreatePoints ( / blksObj doc pt spc ss oldstr)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq blksObj (vla-get-blocks doc))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (SETQ oldstr (getstring  "\n-> INTER NAME ELEVATION :"));ELEV
  (if (setq ss (ssget '((0 . "INSERT") )))
    (progn
      (setq spc (vla-get-modelspace doc))
      (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
;;;	(setq obj (CAR(KGA_Conv_Pickset_To_ObjectList ss)))
        (setq pt (vlax-get obj 'insertionpoint))
        (vla-addpoint spc (vlax-3d-point (list (car pt) (cadr pt) (CADR (LM:parsenumbers(GetLevel (vla-get-name obj) blksObj oldstr))))))
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)
;http://www.lee-mac.com/parsenumbers.html
;; 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)
    )
)

 

0-civil points nove01EP.dwg

Edited May 28, 2020 by hosneyalaa

[BIGAL]

They are anonymous blocks so makes life a bit harder need something like this. Make a list of block names. Note these are entities not attributes in this case.

 

(setq  doc (vla-get-activedocument (vlax-get-acad-object)))

(vlax-for block (vla-get-blocks doc) 
(if   (= (vla-get-name block) "*U62") ; replace block name in a loop
(progn
(setq att1 (vla-get-textstring  (vla-item block 0)))
(setq att2  (vla-get-textstring (vla-item block 1)))
(setq att3  (vla-get-textstring (vla-item block 2)))
)
)
)

 

[Roy_043]

@BIGAL

I don't understand why you describe a problem that is already handled by the original code.

 

Compared to the previous discussion two new problems have been introduced:

1. The text that needs to be read contains mtext formatting. IMO using mtext formatting here makes no sense at all.
2. After removing the formatting, the text has to be parsed to find the actual numerical value.

Edited May 29, 2020 by Roy_043

[hosneyalaa]

 

HI ALL 

Roy_043 AND BIGAL

The problem with this line only

when I write  "*ELEV*"  directly work LISP fine

((wcmatch (vla-get-textstring obj) "*ELEV*")

(setq out (vla-get-textstring obj))

((wcmatch (vla-get-textstring obj) "*ELEV*") 

(setq out (vla-get-textstring obj))

But

When I want to  a variable depending on what the user enters,

it does not work
Thank you

((wcmatch (vla-get-textstring obj) (strcat "*"oldtxtstr"*"))
        (setq out (vla-get-textstring obj))

 

(defun GetLevel (nme blksObj / out)
  (vlax-for obj (vla-item blksObj nme)
    (cond
      (out);1
      ((/= "V-NODE-TEXT" (strcase (vla-get-layer obj)))
        nil
      );2
      ((= "AcDbBlockReference" (vla-get-objectname obj))
        (setq out (GetLevel (vla-get-name obj) blksObj))
      );3
      ((not (vlax-property-available-p obj 'textstring))
        nil
      );4
      ((wcmatch (vla-get-textstring obj) "*ELEV*")
        (setq out (vla-get-textstring obj))
      );5
    );COND
  )
)

Edited May 29, 2020 by hosneyalaa

[Roy_043]

The proposed LM:parsenumbers function can actually be used to solve both new problems:

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

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

(defun c:CreatePoints ( / blksObj doc pt spc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq blksObj (vla-get-blocks doc))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "INSERT")))) ; Removed layer filter.
    (progn
      (setq spc (vla-get-modelspace doc))
      (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
        (setq pt (vlax-get obj 'insertionpoint))
        (vla-addpoint spc (vlax-3d-point (list (car pt) (cadr pt) (GetLevel (vla-get-name obj) blksObj))))
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

 

[hosneyalaa]

 Roy_043

Thank you so much
you are a great man
This LISP gives the required
In both cases
Thank you so much