;; WXREF (gile)

(defun c:btx
(/ dcl_id loop prefix insBase ss basePt insPt insTyp filename unit lst opt xref)
(vl-load-com)
(defun *error* (msg)
(or (= msg "Fonction annulיe")
(princ (strcat "\nErreur: " msg))
)
(and ss (vla-delete ss))
(foreach l lst (vla-put-Lock l :vlax-true))
(vla-EndUndoMark *acdoc*)
(princ)
)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
(setq dcl_id (load_dialog "Wxref.dcl")
loop 2
prefix (getvar 'dwgprefix)
insBase T
basePt '(0. 0. 0.)
unit (getvar 'insunits)
filename (UnicFilename "XREF" prefix ".dwg")
)
(while (<= 2 loop)
(if (not (new_dialog "wxref" dcl_id))
(exit)
)
(start_list "unit")
(mapcar 'add_list
'("Unitless" "Inches" "Feet"
"Miles" "Millimetres" "Centimetres"
"Metres" "Kilometres" "Microinches"
"Milles" "Yards" "Angstrems"
"Nanometres" "Microns" "Decimetres"
"Decametres" "Hectometres" "Gigametres"
"Astronomical Units" "Parsecs"
)
)
(end_list)
(set_tile "unit" (itoa unit))
(set_tile "filename" filename)
(if ss
(mode_tile "accept" 0)
(mode_tile "accept" 1)
)
(if insBase
(progn
(set_tile "insBase" "1")
(mode_tile "insPt" 1)
)
(progn
(set_tile "insBase" "0")
(mode_tile "insPt" 0)
)
)
(set_tile "baseX" (rtos (car basePt)))
(set_tile "baseY" (rtos (cadr basePt)))
(set_tile "baseZ" (rtos (caddr basePt)))
(if insBase
(progn
(set_tile "insX" (strcat "X : " (rtos (car basePt))))
(set_tile "insY" (strcat "Y : " (rtos (cadr basePt))))
(set_tile "insZ" (strcat "Z : " (rtos (caddr basePt))))
)
)
(if (and insPt (not insBase))
(progn
(set_tile "insX" (strcat "X : " (rtos (car insPt))))
(set_tile "insY" (strcat "Y : " (rtos (cadr insPt))))
(set_tile "insZ" (strcat "Z : " (rtos (caddr insPt))))
)
)
(action_tile "objSel" "(done_dialog 3)")
(action_tile "basePt" "(done_dialog 4)")
(action_tile
"baseX"
"(if (setq coord (distof $value))
(progn
(if basePt
(setq basePt (list coord (cadr basePt) (caddr basePt)))
(setq
basePt
(list coord (get_tile \"baseY\") (get_tile \"baseZ\"))
)
)
(if insBase
(set_tile \"insX\" (strcat \"X : \" $value))
)
)
(progn
(alert \"Enter a valid value\")
(mode_tile \"baseX\" 2)
)
)"
)
(action_tile
"baseY"
"(if (setq coord (distof $value))
(progn
(if basePt
(setq basePt (list (car basePt) coord (caddr basePt)))
(setq
basePt
(list (get_tile \"baseX\") coord (get_tile \"baseZ\"))
)
)
(if insBase
(set_tile \"insY\" (strcat \"Y : \" $value))
)
)
(progn
(alert \"Enter a valid value\")
(mode_tile \"baseY\" 2)
)
)"
)
(action_tile
"baseZ"
"(if (setq coord (distof $value))
(progn
(if basePt
(setq basePt (list (car basePt) (cadr basePt) coord))
(setq
basePt
(list (get_tile \"baseX\") (get_tile \"baseY\") coord)
)
)
(if insBase
(set_tile \"insZ\" (strcat \"Z : \" $value))
)
)
(progn
(alert \"Enter a valid value\")
(mode_tile \"baseZ\" 2)
)
)"
)
(action_tile
"insBase"
"(if (= $value \"1\")
(progn
(mode_tile \"insPt\" 1)
(setq insBase T)
(set_tile \"insX\" (strcat \"X : \" (rtos (car basePt))))
(set_tile \"insY\" (strcat \"Y : \" (rtos (cadr basePt))))
(set_tile \"insZ\" (strcat \"Z : \" (rtos (caddr basePt))))
)
(progn
(mode_tile \"insPt\" 0)
(setq insBase nil)
)
)"
)
(action_tile "insPt" "(done_dialog 5)")
(action_tile
"filename"
"(if (and (findfile $value) (not (overwrite)))
(mode_tile \"filename\" 2)
(setq filename $value)
)"
)
(action_tile "getfile" "(done_dialog 6)")
(action_tile "unit" "(setq unit (atoi $value))")
(action_tile
"accept"
"(if insBase
(setq insPt basePt)
(if (not insPt)
(setq insPt (list
(atof (substr (get_tile \"insX\") 5))
(atof (substr (get_tile \"insY\") 5))
(atof (substr (get_tile \"insZ\") 5))
)
)
)
)
(if (= (get_tile \"attach\") \"1\")
(setq opt :vlax-false)
(setq opt :vlax-true)
)
(done_dialog 1)"
)
(action_tile "cancel" "(setq ss nil) (done_dialog 0)")
(setq loop (start_dialog))
(cond
((= loop 3)
(setq ss (ssget ":L"))
)
((= loop 4)
(if (setq basePt (getpoint "\nSelect Base Point: "))
(setq basePt (trans basePt 1 0))
)
)
((= loop 5)
(if (setq insPt (getpoint "\nSelect Insertion Point: "))
(setq insPt (trans insPt 1 0))
)
)
((= loop 6)
(setq filename (getfiled "Create a Xref DWG file" prefix "dwg" 1))
)
)
)
(unload_dialog dcl_id)
(if ss
(progn
(vla-StartUndoMark *acdoc*)
(setq ss (vla-get-ActiveSelectionSet *acdoc*))
(vlax-for o ss
(vla-Move o (vlax-3d-point basePt) (vlax-3d-point '(0. 0. 0.)))
)
(setq iunt (getvar 'insunits))
(setvar 'insunits unit)
(vla-Wblock *acdoc* filename ss)
(setvar 'insunits iunt)
(vlax-for o ss (vla-delete o))
(vla-delete ss)
(setq ss nil)
(setq xref
(vla-AttachExternalReference
(vla-get-ModelSpace *acdoc*)
filename
(vl-filename-base filename)
(vlax-3d-point insPt)
1.
1.
1.
0.
opt
)
)
(vla-EndUndoMark *acdoc*)
)
)
(princ)
)

;;; UnicFileneme (gile)
;;; Retourne un chemin complet de fichier unique (incrיmentי)
;;;
;;; arguments
;;; pat : modטle du nom de fichier (STR)
;;; dir : chemin du rיpertoire (STR)
;;; ext : extension (STR)

(defun UnicFilename (pat dir ext / ind res)
(setq ind 0)
(while (findfile
(setq res (strcat dir
pat
(cond
((< ind 9) "_00")
((< ind 99) "_0")
(T "_")
)
(itoa (setq ind (1+ ind)))
ext
)
)
)
)
res
)
(c:btx)

*********** WXREF.DCL **********
// Boite de dialogue Wref
wxref :dialog{
label = "WXREF";
:row{
:boxed_column{
label = "Source";
:row{
:button{label = ">>"; key = "objSel"; fixed_width = true;}
:text{label = "Select objects";}
}
:boxed_column{
label = "Point de base";
:row{
:button{label = ">>"; key = "basePt"; fixed_width = true;}
:text{label = "Select Base Point";}
}
:edit_box{label = "X :"; key = "baseX";}
:edit_box{label = "Y :"; key = "baseY";}
:edit_box{label = "Z :"; key = "baseZ";}
}
}
:boxed_column{
label = "Insertion";
:radio_row{
:radio_button{label = "Attach"; key = "attach"; value = "1";}
:radio_button{label = "Overlay"; key = "overlay";}
}
:boxed_column{
label = "Insertion Point";
:toggle{label = "Use the base point"; key = "insBase"; value = "1";}
:row{
:button{label = ">>"; key = "insPt"; fixed_width = true; is_enabled = false;}
:text{label = "Choose a point";}
}
:text{key = "insX";}
:text{key = "insY";}
:text{key = "insZ";}
}
}
}
:boxed_column{
label = "Destination";
:text{label = "Name and path of the file";}
:row{
:edit_box{key = "filename"; edit_width = 54;}
:button{label = "..."; key = "getfile"; fixed_width = true;}
}
:popup_list{label = "Insertion Units"; key = "unit"; edit_width = 30;}
}
ok_cancel;
}

Advertisements