Topic: New lisp comments are welcomed

[HasanCAD]

Code: [Select]

;|----------- Modify Z level  ------------------

  Modify attribute to read level z and
  modify it automaticaly
 
  Modify block angle to 0
 
------------------------------------------------
  Author: Hasan M. Asous, 2013
ALL RIGHT RESERVED TO ALL
  Contact: HasanCAD @ TheSwamp.org,
           asos2000 @ CADTutor.net
           HasanCAD@gmail.com
------------------------------------------------
  Version: 1      2013 04 01
________________________________________________
      |;


;       Subroutine Start       ;

(defun get-objectid-x86-x64  (obj / util) ; fixo @ thesawmp.org
    (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
    (if (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj))) ;_ end of if
    (if (= (type obj) 'vla-object)      (if (> (vl-string-search "x64" (getvar "platform")) 0) (vlax-invoke-method util "GetObjectIdString" obj :vlax-false)
(rtos (vla-get-objectid obj) 2 0))))

(defun LM:vl-SetAttributeValue (block tag value) ; Lee Mac, Copyright © 2010 - www.lee-mac.com
    (setq tag (strcase tag))
    (vl-some (function
       (lambda (attrib)
(if (eq tag (strcase (vla-get-TagString attrib))) (progn (vla-put-TextString attrib value) value))))
     (vlax-invoke block 'GetAttributes)))

;        Subroutine End        ;


;       Mainroutine Start      ;

(defun c:zhght ( / ACSP ADOC BLK CNT FIELDSTR FOO OBJID SSBLK) (vl-load-com)

  (setq blknm "SRVPNO2") ; Block name
  (setq atttg "ELEV2")   ; attribute Tag
  (setvar "fielddisplay" 0)

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq acsp (vla-get-block (vla-get-activelayout adoc)))
  (setq cnt 0)
 
  (if (setq ssblk (ssget "_X" (list (cons 0 "INSERT") (cons 2 "SRVPNO2") (cons 66 1) )))
    (progn
      (while (sslength ssblk)
(setq blk (vlax-ename->vla-object (ssname ssblk cnt)))
(setq objId (get-objectid-x86-x64 blk))
(setq fieldStr (strcat "%<\\AcObjProp Object(%<\\_ObjId " objId ">%).InsertionPoint \\f \"%lu2%pt4%pr3\">%"))
(setq foo (LM:vl-SetAttributeValue blk atttg fieldStr))
(vla-put-rotation blk 0)
(setq cnt (1+ cnt))
))))
(princ)

;       Mainroutine End        ;


[HasanCAD]

Is there a way to change attributes textstyle?

[Jürg Menzi]

Hi Hasan

Use (vla-put-StyleName AttributeObject "TextStyle").
Note: "TextStyle" must exist.

Cheers

[Coder]

What's the use of the following functions in your codes ?.

Code: [Select]

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq acsp (vla-get-block (vla-get-activelayout adoc)))

You assigned string to a variable and did not use it .

Code: [Select]

(setq blknm "SRVPNO2") ; Block name

How this would end ?

Code: [Select]

(while (sslength ssblk)

You are changing the system variable without returning it back as it was .

Code: [Select]

  (setvar "fielddisplay" 0)


This is what I have noticed in a quick look .

[HasanCAD]

Code: [Select]

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq acsp (vla-get-block (vla-get-activelayout adoc)))
Deleted

You assigned string to a variable and did not use it .

Code: [Select]

(setq blknm "SRVPNO2") ; Block name
OK

How this would end ?

Code: [Select]

(while (sslength ssblk)
its the selected blocks quantity
You are changing the system variable without returning it back as it was .

Code: [Select]

  (setvar "fielddisplay" 0)
It is needed like that to change system variable

This is what I have noticed in a quick look .
Thanks for your quick look

[Coder]

How this would end ?

Code: [Select]

(while (sslength ssblk)
its the selected blocks quantity

Correct , but it would not end as long as the quantity would not be equal to nil 

You are changing the system variable without returning it back as it was .

Code: [Select]

  (setvar "fielddisplay" 0)
It is needed like that to change system variable

If you are writing that code for yourself , I agree otherwise you should add error trap to reset the user settings .

[HasanCAD]

Correct , but it would not end as long as the quantity would not be equal to nil 

Correct , but it would not end as long as the quantity would not be equal to nil 

Is this solution good

Code: [Select]

(if (< 0 (sslength (setq ssblk (ssget "_X" (list (cons 0 "INSERT") (cons 2 blknm) (cons 66 1) )))))
    (progn
      ))

[Jürg Menzi]

Hi Hasan

Code: [Select]

(if (setq ssblk (ssget "_X" (list (cons 0 "INSERT") (cons 2 "SRVPNO2") (cons 66 1))))
 (while (setq Ent (ssname ssblk 0))
  (setq blk (vlax-ename->vla-object Ent))
  ...
  (ssdel Ent ssblk)
 )
)does the stuff...

Cheers