Jump to content

Recommended Posts

Posted

Hey guys,


I got a friend of mine to create a lisp program some time back which has been working fine up to now. Unfortunately he passed away a few years back so i cant get him to fix it.

 

It reads the attributes from a block and draws a 3d string to those invert levels in the attributes then writes to the attributes and updates the grade and pipe length.

The problem is now the block is inserted into a mleader and the only way to read and write to it is by exploding the mleader.

Can this lisp be modified to work with the mleader and block within it instead of exploding it ?

BTW Appreciate any help as I am not much good at lisp and only a beginner. Sorry.

Posted

Thanks Bigal.

It wouldn't let me yesterday but i'll try again.

22 hours ago, AlexS said:

Hey guys,


I got a friend of mine to create a lisp program some time back which has been working fine up to now. Unfortunately he passed away a few years back so i cant get him to fix it.

 

It reads the attributes from a block and draws a 3d string to those invert levels in the attributes then writes to the attributes and updates the grade and pipe length.

The problem is now the block is inserted into a mleader and the only way to read and write to it is by exploding the mleader.

Can this lisp be modified to work with the mleader and block within it instead of exploding it ?

BTW Appreciate any help as I am not much good at lisp and only a beginner. Sorry.

 

Posted

Here they are.... Sorry

If you explode the info box then the lisp works though not when all together.

 

Thanks for any help in advance

Pipe3D.LSP SAMPLE.dwg

Posted (edited)

If you use Nentsel can read the values in the block. Struggle to understand the rest of the task. Understand grade and length use.

 

(setq blk (nentsel "\nPick block"))
(setq vals (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 302)) (entget (car blk)))))
(princ vals)

("LEADER{" "9.80" "150" "xxx" "00.0" "9.21" "")

 

Edited by BIGAL
Posted

Thanks Bigal,
So can this be incorporated into the lisp routine so it reads the invert levels from the block, creates the 3d string to those levels, then rewrites the grade and pipe length to the block? in the script.

Regards Alex
 

Posted

INSTRUCTIONS

 

Thought I'd write this to clarify what I mean 😀

 

If you open the Sample.dwg and explode the leader so the block is separated from the mleader then this lisp will work fine.

 

Then use Appload and load the pipe3d.lsp and type pipe3d to run it.

It will prompt you to select the upstream end of the pipe and please select the top of the red line.

It will then prompt to select the pipe info block.

it will then read the upstream invert level from the pipe info block and the downstream invert level and draw a 3d line over the top of the red line (to these invert levels).
then it will update the block and add the pipe length and pipe grade and done 😀

 

The lisp routine works fine though the only problem i have is i have to explode the mleader from the block to do this.

Can this routing be amended to do this without exploding the mleader from the block ?

 

Appreciate any help i can get.

 

Regards Alex

 

Posted

Give this a try. The get property was the secret.

; https://www.cadtutor.net/forum/topic/96175-mleader-with-block-and-attributes/#comment-662196
; read and update a mleader block attributes 
; By AlanH Feb 2025

(defun c:blkgr ( / 10s blkent end grade il1 il2 len oldsnap start z)

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(setq blkent (car (entsel "\nPick leader ")))


(setq il1 (atof  (getpropertyvalue blkent "USIL~BlockAttribute")))
(setq il2 (atof  (getpropertyvalue blkent "DSIL~BlockAttribute")))

(setq 10s (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget blkent))))
(setq pt (nth 2 10s))

(setq obj (vlax-ename->vla-object (ssname (ssget pt '((0 . "LINE"))) 0)))

(setq start (vlax-curve-getstartPoint obj))
(setq end (vlax-curve-getEndPoint obj))
(setq len (vlax-get obj 'length))
(setq start (list (car start)(cadr start) il1))
(setq end (list (car end)(cadr end) il2))
(command "3dline" start end "")

(setq z (- il2 il1))
(setq grade (strcat (rtos (* 100. (/ z len)) 2 1) " %"))

(setpropertyvalue blkent "GR~BlockAttribute" grade)
(setpropertyvalue blkent "LENGTH~BlockAttribute" (rtos len 2 2))

(setvar 'osmode oldsnap)
(princ)
)
(c:blkgr)

 

Posted

Thanks Bigal,

 

I run it and get this error.

 

image.png.3e3f8f1c6330f0e294ecd5134222fa1a.png

 

I was hoping for a change to the original list for it to now work ? As mentioned i'm a noob and not sure if this script was suppose to be pasted into the LSP or what.

Thanks for your help.

Posted

Did you save the code as a .lsp file ? Then use appload or drag & drop using explorer. The message is odd as it looks like it does not get past the first user request. 

Posted

Thanks Bigal,
I saved it as a LSP file and used Appload to load and run it.

It didn't do much ? Prompted to select the leader then came up with the error.

Sorry.

 

Posted

I am a bit stuck works for me testing on your Sample.dwg. Did you test with that dwg ? If it works then post other dwg. 

Posted

I am using Bricscad and it works, what does this show when selecting the mleader re the attributes.

 

(dumpallproperties (car (entsel "\nPick mleader ")))

 

----- Block Attributes
DIA (ident: "DIA~BlockAttribute")  (string) (RO) = "150"
DSIL (ident: "DSIL~BlockAttribute")  (string) (RO) = "9.21"
EX (ident: "EX~BlockAttribute")  (string) (RO) = ""
GR (ident: "GR~BlockAttribute")  (string) (RO) = "xxx"
LENGTH (ident: "LENGTH~BlockAttribute")  (string) (RO) = "00.0"
USIL (ident: "USIL~BlockAttribute")  (string) (RO) = "9.80"

 

Posted (edited)

This is what i get when i run the dumpall

 

Command: (dumpallproperties (car (entsel "\nPick mleader ")))
Pick mleader Begin dumping object (class: AcDbMLeader)
Annotative (type: bool)  (LocalName: Annotative) = 0
AnnotativeScale (type: AcString)  (RO)  (LocalName: Annotative scale) = Failed to get value
ArrowSize (type: double)  (LocalName: Arrowhead Size) = 2.500000
ArrowSymbolId (type: AcDbObjectId) = 0
ArrowheadType (type: AcString)  (LocalName: Arrowhead) =
BlockColor (type: AcCmColor) = BYLAYER
BlockConnectionType (type: AcDbMLeaderStyle::BlockConnectionType)  (LocalName: Attachment) = 0
BlockContentId (type: AcDbObjectId) = 2abc64283d0
BlockId (type: AcDbObjectId)  (RO) = 2abc6429700
BlockPosition/X (type: double) = 52.397815
BlockPosition/Y (type: double) = 64.885418
BlockPosition/Z (type: double) = 0.000000
BlockRotation (type: double) = 0.000000
BlockScale/UniformScale (type: double)  (LocalName: Scale) = 2.500000
CastShadows (type: bool) = 1
ClassName (type: AcString)  (RO) =
CollisionType (type: AcDb::CollisionType)  (RO) = 1
Color (type: AcCmColor)  (LocalName: Color) = BYLAYER
ContentBlockType (type: BlockType)  (LocalName: Source block) = 6
ContentType (type: AcDbMLeaderStyle::ContentType) = 1
DoglegLength (type: double)  (LocalName: Landing distance) = 3.000000
EnableAnnotationScale (type: bool) = 0
EnableDogleg (type: bool)  (LocalName: Horizontal Landing) = 1
EnableFrameText (type: bool)  (LocalName: Text frame) = Failed to get value
EnableLanding (type: bool) = 1
ExtendLeaderToText (type: bool)  (LocalName: Leader extension) = Failed to get value
ExtensionDictionary (type: AcDbObjectId)  (RO) = 0
Handle (type: AcDbHandle)  (RO) = 26f
HasFields (type: bool)  (RO) = 0
HasSaveVersionOverride (type: bool) = 0
Hyperlinks (type: AcDbHyperlink*)
IsA (type: AcRxClass*)  (RO) = AcDbMLeader
IsAProxy (type: bool)  (RO) = 0
IsCancelling (type: bool)  (RO) = 0
IsEraseStatusToggled (type: bool)  (RO) = 0
IsErased (type: bool)  (RO) = 0
IsModified (type: bool)  (RO) = 0
IsModifiedGraphics (type: bool)  (RO) = 0
IsModifiedXData (type: bool)  (RO) = 0
IsNewObject (type: bool)  (RO) = 0
IsNotifyEnabled (type: bool)  (RO) = 0
IsNotifying (type: bool)  (RO) = 0
IsObjectIdsInFlux (type: bool)  (RO) = 0
IsPersistent (type: bool)  (RO) = 1
IsPlanar (type: bool)  (RO) = 0
IsReadEnabled (type: bool)  (RO) = 1
IsReallyClosing (type: bool)  (RO) = 1
IsTransactionResident (type: bool)  (RO) = 0
IsUndoing (type: bool)  (RO) = 0
IsWriteEnabled (type: bool)  (RO) = 0
LandingGap (type: double)  (LocalName: Landing gap) = Failed to get value
LayerId (type: AcDbObjectId)  (LocalName: Layer) = 2abc6428390
LeaderCount (type: int)  (RO) = 1
LeaderLineColor (type: AcCmColor)  (LocalName: Leader color) = BYLAYER
LeaderLineCount (type: int)  (RO) = 1
LeaderLineType (type: AcDbMLeaderStyle::LeaderType)  (LocalName: Leader type) = 1
LeaderLineTypeId (type: AcDbObjectId)  (LocalName: Leader linetype) = 2abc64295c0
LeaderLineWeight (type: AcDb::LineWeight)  (LocalName: Leader lineweight) = -1
LineWeight (type: AcDb::LineWeight)  (LocalName: Lineweight) = -1
LinetypeId (type: AcDbObjectId)  (LocalName: Linetype) = 2abc64295c0
LinetypeScale (type: double)  (LocalName: Linetype scale) = 1.000000
LocalizedName (type: AcString)  (RO) = Multileader
MLeaderStyle (type: AcDbObjectId)  (LocalName: Multileader style) = 2abc64286d0
MText (type: AcDbMText*) =
MText/BackgroundFill (type: bool)  (RO)  (LocalName: Background mask) = Failed to get value
MText/Contents (type: AcString)  (RO)  (LocalName: Contents) = Failed to get value
MText/FlowDirection (type: AcDbMText::FlowDirection)  (RO)  (LocalName: Direction) = Failed to get value
MText/LineSpaceDistance (type: double)  (RO)  (LocalName: Line space distance) = Failed to get value
MText/LineSpacingFactor (type: double)  (RO)  (LocalName: Line space factor) = Failed to get value
MText/LineSpacingStyle (type: AcDb::LineSpacingStyle)  (RO)  (LocalName: Line space style) = Failed to get value
MText/Rotation (type: double)  (RO)  (LocalName: Rotation) = Failed to get value
MText/TextHeight (type: double)  (RO)  (LocalName: Height) = Failed to get value
MText/TextStyleId (type: AcDbObjectId)  (RO)  (LocalName: Text style) = Failed to get value
MText/Width (type: double)  (RO)  (LocalName: Width) = Failed to get value
MaterialId (type: AcDbObjectId)  (LocalName: Material) = Failed to get value
MergeStyle (type: AcDb::DuplicateRecordCloning)  (RO) = 1
Normal/X (type: double)  (RO) = 0.000000
Normal/Y (type: double)  (RO) = 0.000000
Normal/Z (type: double)  (RO) = 1.000000
ObjectId (type: AcDbObjectId)  (RO) = 2abc6428770
OwnerId (type: AcDbObjectId)  (RO) = 2abc6429700
PlotStyleName (type: AcString)  (RO)  (LocalName: Plot style) = ByColor
ReceiveShadows (type: bool) = 1
ScaleFactor (type: double)  (LocalName: Overall scale) = 1.000000
ScaledTextHeight (type: double) = 2.500000
ShadowDisplay (type: AcDb::ShadowFlags)  (LocalName: Shadow Display) = Failed to get value
TextAlignmentType (type: AcDbMLeaderStyle::TextAlignmentType)  (LocalName: Justify) = 0
TextAngleType (type: AcDbMLeaderStyle::TextAngleType) = 1
TextAttachmentDirection (type: AcDbMLeaderStyle::TextAttachmentDirection)  (LocalName: Attachment type) = Failed to get value
TextBottomAttachmentType (type: AcDbMLeaderVerticalTextAttachmentTypeEnum)  (LocalName: Bottom Attachment) = Failed to get value
TextColor (type: AcCmColor) = BYLAYER
TextLeftAttachmentType (type: AcDbMLeaderHorizontalTextAttachmentTypeEnum)  (LocalName: Left Attachment) = Failed to get value
TextLocation/X (type: double) = Failed to get value
TextLocation/Y (type: double) = Failed to get value
TextLocation/Z (type: double) = Failed to get value
TextRightAttachmentType (type: AcDbMLeaderHorizontalTextAttachmentTypeEnum)  (LocalName: Right Attachment) = Failed to get value
TextStyleId (type: AcDbObjectId) = 2abc64285a0
TextTopAttachmentType (type: AcDbMLeaderVerticalTextAttachmentTypeEnum)  (LocalName: Top Attachment) = Failed to get value
ToleranceLocation/X (type: double) = Failed to get value
ToleranceLocation/Y (type: double) = Failed to get value
ToleranceLocation/Z (type: double) = Failed to get value
Transparency (type: AcCmTransparency)  (LocalName: Transparency) = 0
Visible (type: AcDb::Visibility) = 0
End object dump
nil

 

Edited by SLW210
Added Code Tags!!
Posted

I did my testing with Bricscad V25, which obviously now has a extended feature when it comes to using setpropertyvalue. I did start with using entgets and you can get from a single pick from memory the attribute values they are dxf 302's, you can get the leader start point which is the 3rd item, I use a ssget pt and find the line it touches and make the 3d line. The problem I had was I could not work out how to update a 302 code. The grade and length

 

(setq blkent (car (entsel "\nPick leader ")))
(setq 10s (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget blkent))))
(setq 302s (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 302))(entget blkent)))) ; attribute values
(setq pt (nth 2 10s))  ; 3rd is arrow point

 

Entget mleader somewhere in this is the entity id for the block or I kept getting the Block definition so somewhere else is the attributes, 

The 330's are the link to the attribute in the block definition not the actual block. I am sure someone will find something from the values.

 

 

Posted

Thanks Bigal,

 

I thought this was gonna be a simple fix to start with... Obviously blocks nested in mleaders isn't straight forward.

 

Thanks for all your help.

Posted

Try this version with big thanks to Lee-Mac.

; https://www.cadtutor.net/forum/topic/96175-mleader-with-block-and-attributes/#comment-662196
; read and update a mleader block attributes 
; By AlanH Feb 2025
; Big thanks to lee-mac for change attribute in mleader block.

(defun c:blkgr ( / 10s 302s blkent end grade il1 il2 len oldsnap start z)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq blkent (car (entsel "\nPick leader ")))
(setq blkobj (vlax-ename->vla-object blkent))
(setq 10s (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget blkent))))
(setq 302s (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 302))(entget blkent))))
(setq il1 (atof (nth 1 302s)) il2 (atof (nth 5 302s)))
(setq pt (nth 2 10s))
(setq obj (vlax-ename->vla-object (ssname (ssget pt '((0 . "LINE"))) 0)))
(setq start (vlax-curve-getstartPoint obj))
(setq end (vlax-curve-getEndPoint obj))
(setq len (vlax-get obj 'length))
(setq start (list (car start)(cadr start) il1))
(setq end (list (car end)(cadr end) il2))
(command "3dline" start end "")
(setq z (- il2 il1))
(setq grade (strcat (rtos (* 100. (/ z len)) 2 1) " %"))
(LM:SetMLeaderBlockAttributeValue blkobj "GR" grade)
(LM:SetMLeaderBlockAttributeValue blkobj "LENGTH" (rtos len 2 3))
(setvar 'osmode oldsnap)
(princ)
)


;;---------=={ Set MLeader Block Attribute Value }==----------;;
;;                                                            ;;
;;  Sets the value of the specified tag for the specified     ;;
;;  MLeader                                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  mleader - ename/VLA-Object MLeader with attributed block  ;;
;;  tag     - Tagstring of the attribute to change            ;;
;;  value   - Value to which attribute will be set            ;;
;;------------------------------------------------------------;;
;;  Returns:  T if successful, else nil                       ;;
;;------------------------------------------------------------;;
   ;; © Lee Mac 2010
(defun LM:SetMLeaderBlockAttributeValue ( mleader tag value / def id )
  (vl-load-com)
  (if
    (and
      (eq "AcDbMLeader"
        (vla-get-Objectname
          (setq mleader
            (cond
              ( (eq 'VLA-OBJECT (type mleader)) mleader)
              ( (vlax-ename->vla-object mleader) )
            )
          )
        )
      )
      (= 1 (vla-get-ContentType mleader))
      (setq def
        (LM:Itemp
          (vla-get-Blocks
            (vla-get-ActiveDocument
              (vlax-get-acad-object)
            )
          )
          (vla-get-ContentBlockName mleader)
        )
      )
    )
    (if
      (progn
        (vlax-for obj def
          (if (and (eq "AcDbAttributeDefinition" (vla-get-Objectname obj))
                   (eq (strcase tag) (strcase (vla-get-TagString obj))))
            (setq id (vla-get-ObjectID obj))
          )
        )
        id
      )
      (not (vla-SetBlockAttributeValue mleader id value))
    )
  )
)
 
;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  coll - the VLA Collection Object                          ;;
;;  item - the index of the item to be retrieved              ;;
;;------------------------------------------------------------;;
;;  Returns:  the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;
  ;; © Lee Mac 2010
  
(defun LM:Itemp ( coll item )
  (if
    (not
      (vl-catch-all-error-p
        (setq item
          (vl-catch-all-apply
            (function vla-item) (list coll item)
          )
        )
      )
    )
    item
  )
)

(c:blkgr)

 

Posted

thanks Bigal

 

Appreciate all your help.


I gave it a go and when i select the leader it responds....

 

Pick leader ; error: bad argument type: lselsetp nil
 

Any idea why ?

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...