TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: TJAM51 on December 17, 2004, 09:23:46 AM
-
I have a routine that uses a line and it's own arrowhead. I would like to use a autocad leader....how could I do this?
Thanks
(DEFUN C:EQUIP-co (/ PB1 PT1 PT2 LAY SCL PLY AGL RTD ANG)
(SETQ PB1 (GETVAR "PICKBOX"))
(SETVAR "CMDECHO" 0)
(SETQ PT1 (GETPOINT "\nFrom Point: ")
PT2 (GETPOINT PT1 "\nTo Point: ")
LAY (GETVAR "CLAYER")
SCL (GETVAR "DIMSCALE")
PLY (* SCL 0.2806)
AGL (ANGLE PT1 PT2)
RTD (/ 180 PI)
ANG (* RTD AGL))
(COMMAND "COLOR" "bylayer"
"LINE" PT1 PT2 ""
"COLOR" "BYLAYER"
"INSERT" "meinarw" PT1 SCL "" ANG
"POLYGON" "6" PT2 "I" PLY
"TRIM" "L" "" PT2 ""
"ERASE" "L" "")
(SETQ ATT (GETSTRING "\nEquip_type: "))
(SETQ ATT2 (GETSTRING "\nEquip_number: "))
(COMMAND "INSERT" "M-Text-EquipDesig1" PT2 SCL "" "" ATT ATT2)
(COMMAND "SETVAR" "PICKBOX" PB1)
(SETVAR "CMDECHO" 1)
(pickbox "4")
(PRINC))
-
I see no easy way of doing this. You would have to create the leader using activeX methods and then attach the block to the end of it.
Creates a leader line, given the coordinates of the points.
RetVal = object.AddLeader(PointsArray, Annotation, Type)
Object
ModelSpace collection, PaperSpace collection, Block
The object or objects this method applies to.
PointsArray
Variant (array of doubles); input-only
The array of 3D WCS coordinates specifying the leader. You must provide at least two points to define the leader. The third point is optional.
Annotation
Object; input-only
A Tolerance, MText, BlockRef object or NULL.
Type
AcLeaderType enum; input-only
acLineNoArrow
acLineWithArrow
acSplineNoArrow
acSplineWithArrow
RetVal
Leader object
The newly created Leader object.
-
TJ
See if this does anything gor you.
(defun c:equip-co (/ pb1 pt1 pt2 lay scl ply agl rtd ang)
(setq pb1 (getvar "PICKBOX"))
(setvar "CMDECHO" 0)
(setq pt1 (getpoint "\nFrom Point: ")
pt2 (getpoint pt1 "\nTo Point: ")
lay (getvar "CLAYER")
scl (getvar "DIMSCALE")
ply (* scl 0.2806)
agl (angle pt1 pt2)
rtd (/ 180 pi)
ang (* rtd agl)
)
(command "COLOR" "bylayer")
(setq pt0 (polar pt2 (angle pt2 pt1) (/ ply 2)))
(command ".qleader" pt1 pt0 ^c ^c); create leader only
(command "INSERT" "meinarw" pt1 scl "" ang)
(setq att (getstring "\nEquip_type: "))
(setq att2 (getstring "\nEquip_number: "))
(command "INSERT" "M-Text-EquipDesig1" pt2 scl "" "" att att2)
(command "SETVAR" "PICKBOX" pb1)
(setvar "CMDECHO" 1)
(pickbox "4")
(princ)
)
-
Thanks Mark and Cab. I understand the difficulty. Cab's routine works but does not trim inside the block. I need to somehow trim inside the block called M-Text-EquipDesig1.
Thanks
-
TJ
Sorry about that, try this one.
(defun c:equip-co (/ pb1 pt1 pt2 lay scl ply agl rtd ang)
(setq pb1 (getvar "PICKBOX"))
(setvar "CMDECHO" 0)
(setq pt1 (getpoint "\nFrom Point: ")
pt2 (getpoint pt1 "\nTo Point: ")
lay (getvar "CLAYER")
scl (getvar "DIMSCALE")
ply (* scl 0.2806)
agl (angle pt1 pt2)
rtd (/ 180 pi)
ang (* rtd agl)
)
(command "COLOR" "bylayer")
(setq pt0 (polar pt2 (angle pt2 pt1) ply))
(command ".POLYGON" "6" PT2 "I" PLY)
(setq ent (entlast))
(command ".qleader" "_non" pt1 "_nea" pt0 ^c ^c); create leader only
(entdel ent)
(command "INSERT" "meinarw" pt1 scl "" ang)
(setq att (getstring "\nEquip_type: "))
(setq att2 (getstring "\nEquip_number: "))
(command "INSERT" "M-Text-EquipDesig1" pt2 scl "" "" att att2)
(command "SETVAR" "PICKBOX" pb1)
(setvar "CMDECHO" 1)
(pickbox "4")
(princ)
)
-
This is what I was talking about. Needs some clean-up work.
;;; run like so
;;; (setq pts (make-lder-pts))
;;; (leader-obj pts "blockname")
(defun leader-obj (pts_lst blk_name /
; local functions
mspace
; local variables
blk_scale insertpoint block_object tmparray tmp
ledrobject
)
(defun mspace ()
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(setq blk_scale (getvar 'dimscale)
insertpoint (list (nth 6 pts_lst)(nth 7 pts_lst)(last pts_lst))
)
(setq block_object
(vla-InsertBlock
(mspace)(vlax-3D-point insertPoint)
blk_name blk_scale blk_scale blk_scale 0.0)
); setq
(setq tmparray
(vlax-make-safearray
vlax-vbDouble
(cons 0 (- (length pts_lst) 1))
)
)
(vlax-safearray-fill tmparray pts_lst)
(setq tmp (vlax-make-variant tmparray))
; create Leader object
(setq
ledrobject
(vla-addleader (mspace) tmp block_object aclinewitharrow)
)
(vlax-put-property
ledrobject 'ArrowheadSize (* (getvar 'dimasz)(getvar 'dimscale))
)
(mapcar 'vlax-release-object (list ledrobject block_object))
)
(defun make-lder-pts (/ mspace ledrstartpoint ledrmidpoint
ledrline1 ledrendpoint ledrpoints)
(defun mspace ()
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
(if
(and
(setq
ledrstartpoint
(getpoint "\nStart Point of Leader...")
)
(setq
ledrmidpoint
(getpoint ledrstartpoint "\nSecond Point of Leader...")
)
); and
(progn
(setq
ledrline1
(vla-addLine
(mspace)
(vlax-3d-point (list (car ledrstartpoint)(cadr ledrstartpoint)))
(vlax-3d-point (list (car ledrmidpoint)(cadr ledrmidpoint)))
)
)
(setq
ledrendpoint
(getpoint ledrmidpoint "\nLast Point of Leader...")
)
(vla-erase ledrline1)
; replace all Z's with 0.0
(setq ledrpoints
(apply
'append
(mapcar
'(lambda (x) (subst 0.0 (last x) x))
(list ledrstartpoint ledrmidpoint ledrendpoint)
)
)
)
); progn
; else
(exit)
)
ledrpoints
)