; ** 19-May-08 NEHolt created ; ----------- W N U M 2 P I C K . L S P -------------------- (defun c:wnum2pick ( / overwrite str xy wen ed xitflg netlst skip options base_start fmt layer dwg_wirenum_lst wfmt_lst wnum options_lst x p_i pc_h pc_v pc_s pc_d pp pl suffix_lst w_layer wfmt_l reftxt same_lr_cnt ovrfmt new_w existing curdwg_sec curdwg_subsec) ; Insert fixed wire number at user pick point on wire ; newtwork. Base wire number upon the pick point's XY ; coordinate, NOT the wire network's beginning XY point. ; Initialize if this is first cmd run on this drawing (if (not (wd_cfg_chk_ifsame)) (c:wd_1)) ; Read in drawing's WD_M block settings (if not in memory) (if (not GBL_wd_m) (wd_cfg_read_dwg_params)) ; Read in all other information that may be required to ; insert into the wire number format. (wd_1_luk4_mlrs) ; read in any ladder info ; Get wire number suffix list from drawing's global param block (setq suffix_lst (wd_1_delim_str_to_lst (nth 8 GBL_wd_m) "," )) (setq ovrfmt (nth 9 GBL_wd_m)) ; use default wire number format (setq curdwg_sec nil curdwg_subsec nil) ; may need current dwgs SEC and SUBSEC values for %A or %B params. ; Get current dwg's SEC/SUBSEC values (if defined) from ; the project drawing list (.wdp file) (setq x (wd_mdb_get_curdwg_sec_subsec)) (setq curdwg_sec (car x) curdwg_subsec (cadr x)) (if (OR (= (nth 1 GBL_wd_m) "4") (= (nth 1 GBL_wd_m) "5")) (progn ; GRID X-Y format in use. Use global wire number suffix list. (setq wfmt_l (list (wd_redef_breakdown_fmt (list ovrfmt)))) (setq fmt (car wfmt_l)) ) ; ELSE (progn ; Build list of wire number formats, one for each ladder column (if (not GBL_wd_ldr) (setq wfmt_l (list (wd_redef_breakdown_fmt (list ovrfmt)))) ; no ladders found. Use def. ; ELSE (setq wfmt_l '()) ) (foreach x GBL_wd_ldr (setq fmt (nth 6 x)) ; Get custom format for column (if defined) (if (OR (not fmt) (= (strlen fmt) 0)) ; None defined for this column. Get global value. (setq fmt (nth 9 GBL_wd_m)) ) ; Break down the format string into a sub-list of component parts (setq wfmt_l (cons (wd_redef_breakdown_fmt (list fmt)) wfmt_l)) ) (setq wfmt_l (reverse wfmt_l)) ; put into correct order ) ) (setq pc_s (nth 13 GBL_wd_m)) (setq pc_d (nth 46 GBL_wd_m)) (setq pp (nth 51 GBL_wd_m)) (setq p_i (nth 52 GBL_wd_m)) (setq pl (nth 53 GBL_wd_m)) (setq Z_prev nil) ; this is a global used to determine if ; internal AutoCAD Electrical function ; has done a "zoom extents" (setvar "CMDECHO" 0) ; cleaner looking command window ; Get list of existing wire nums on the active drawing (if (not dwg_wirenum_lst) (setq dwg_wirenum_lst (wd_wnum_get_dwg_wnum_list)) ) (setq xitflg nil) (while (not xitflg) (setq xitflg T) ; default to exit loop (setq x (entsel "\nNext wire number insertion point (pick on wire):")) (if x (progn (setq xy (cadr x)) ; pick point (setq wen (car x)) ; entity name of wire (setq reftxt (car (wd_1_get_xr xy))) (setq str reftxt) (setq new_w reftxt) (setq same_lr_cnt 0) ; Calculate the wire number (setq new_w (wd_1a_fmt_into_fmt (list fmt reftxt "" pc_h pc_v pc_s pc_d pp p_i pl (wd_wnum_get_next_suffix same_lr_cnt suffix_lst) curdwg_sec curdwg_subsec w_layer ) 1 )) ; Make sure wire number not used before. If so, ; increment suffix until unique. (while (member new_w dwg_wirenum_lst) (setq new_w (wd_1a_fmt_into_fmt (list fmt reftxt "" pc_h pc_v pc_s pc_d pp p_i pl (wd_wnum_get_next_suffix same_lr_cnt suffix_lst) curdwg_sec curdwg_subsec w_layer ) 1 )) (setq same_lr_cnt (1+ same_lr_cnt)) ) (setq ed (entget wen)) ; open up the entity, see if ; it is a LINE entity (if (= (cdr (assoc 0 ed)) "LINE") (progn ; looks good so far ; Make sure that this line is on a valid wire layer (if (not (wd_lay_verify_wire_lay (cdr (assoc 8 ed)))) (progn ; Not on a wire layer. Display error msg. (princ "Line is not on a wire layer") (setq xitflg nil) ; stay in loop but do not ;increment wire number ) ; ELSE (progn ; Make sure that this network does not ; carry a "Destination" arrow. This means that ; we cannot predefine the wire number on this ; network (it must be defined on the "source" ; part of the network) (setq netlst (c:wd_get_wire_netlst wen 1)) (if Z_prev (command "_.ZOOM" "_PREV")) (setq Z_prev nil) (if (nth 5 netlst) (progn (princ (strcat "\n Destination arrow on this" " network. Fixed wire number not allowed.")) (setq xitflg nil) ; stay in loop but do not ; increment wire number ) ; ELSE (progn (setq skip nil) (setq existing (c:ace_get_wnum wen)) (if (/= overwrite "A") (progn ; Check if this wire network already ; has a wire number assignment (if existing (progn ; returns x=(list wnum wnum_blk_en) (princ " existing= ") (princ (car existing)) (setq x (getstring " Overwrite? (Y//yes to All)":)) (if (= (strcase (substr x 1 1)) "A") (progn ; overwrite all, do not prompt (setq overwrite "A") (setq xitflg nil) ; stay in loop ) ; ELSE (if (OR (= (strcase (substr x 1 1)) "N") (= x "")) (progn ; do not overwrite existing wnum (setq xitflg nil) ; stay in loop ; but don't increment (setq skip T) ) ) ) ) ) ) ) (if (not skip) (progn ; okay to insert the fixed wire number now! ; Delete any old wire number at its position ; to make way for new wire number inserted ; at new pick point. (if existing (c:ace_del_wnum wen)) (setq x (c:wd_putwnxyf xy new_w)) (if x (progn ; Save wire number in active dwg's list of existing ; wire numbers (setq dwg_wirenum_lst (cons new_w dwg_wirenum_lst)) (setq xitflg nil) ; stay in loop ) ) ) ) (if Z_prev (command "_.ZOOM" "_PREV")) (setq Z_prev nil) ) ) ) ) ) ; ELSE (progn ; not a LINE (princ " ??") (setq xitflg nil) ; stay in loop but don't increment wire number text ) ) ) ) ) (princ) )