马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
功能:可依点击诸零件自动生成所点击数目的序号球;
自动左右对齐和决定明细表表头上下位置;
可选序号球排列所在直线(水平或垂直);
即时输入零件名称及材料数量等;
可选明细表栏目宽度,行高,字高;
可选序号球引线端部结构。
请试用,并提出意见。
[PHP]
(defun c:test (/ ee pl)
(setvar "osmode" 0)
(setq index (load_dialog (findfile "dial.dcl")))
(if (not (new_dialog "dbom" index))(exit))
;(imagep)
(setq tlist (list "Arrow" "Dot" "Blank" ""))
(start_list "ttype")
(mapcar 'add_list tlist)
(end_list)
(action_tile "pick" "(setq h (atof (get_tile \"h\"))
th (atof (get_tile \"th\"))
c1 (atof (get_tile \"c1\"))
c2 (atof (get_tile \"c2\"))
c3 (atof (get_tile \"c3\"))
c4 (atof (get_tile \"c4\")))
(done_dialog 2)")
(action_tile "cancel" "(setq lp 1)(exit)")
(setq do_what (start_dialog))
(if (= do_what 2)
(while (setq p (getpoint "\nPick Point in Part: "))(setq pl (cons p pl)))
)
(unload_dialog index)
(setq sn 1)
(setq r (* 1.2 th))
(setvar "orthomode" 1)
(setq ps (getpoint "\nPick the First Point: "))
(setq pe (getpoint ps "\nPick the First Point: "))
(if (equal (cadr ps)(cadr pe) 0.0001)
(setq pl (vl-sort pl '(lambda (p1 p2)(< (car p1)(car p2)))))
(setq pl (vl-sort pl '(lambda (p1 p2)(< (cadr p1)(cadr p2)))))
)
(if (or (> (car ps)(car pe))(> (cadr ps)(cadr pe)))
(setq pl (reverse pl))
)
(setq l (/ (distance ps pe)(1- (length pl))))
;(mlayer "dim" 4 "continous")
(setq n 0)
(while (< n (length pl))
(vl-cmdf "circle" ps r)
(vl-cmdf "text" "j" "m" ps th 0 (itoa (1+ n)) "")
(setq pte (polar ps (angle ps (nth n pl)) r))
(command "leader" (nth n pl) pte "" "" "n")
(setq ps (polar ps (angle ps pe) l))
(setq n (1+ n))
)
(setq row (length pl))
(setvar "osmode" 37)
(setq p0 (getpoint "\nPick Insert Point of BOM: "))
(setq cl (list c1 c2 c3 c4))
(bom p0 row h th cl)
(setvar "osmode" 37)
)
;
(defun bom (p0 row h th cdlst)
(setvar "osmode" 0)
(vl-load-com)
(setq vps (vla-get-Viewports (vla-get-activedocument (vlax-get-acad-object))))
(setq ss 0)
(setq tdlst (mapcar '(lambda(x)(setq s (+ ss (/ x 2.0)) ss (+ ss x)) s) cdlst))
(setq w (apply '+ cdlst))
(setq txt (list "ITEM" "PART NUMBER" "DWG.No" "QTY."))
(setq pvc (vlax-get (vla-item vps 0) "center"))
(setq ee (ssget "f" (list (polar p0 (/ pi 4) 0.001)(polar p0 (* 1.25 pi) 0.001))))
(if (and ee (> (car p0)(car pvc)))(setq p0 (polar p0 pi w)))
(if (and ee (< (cadr p0)(cadr pvc)))(setq h (- h)))
(setq ss0 (ssget "x" '((0 . "*LINE,TEXT,ATTDEF"))))
(setq n 0)
(while (< n (length tdlst))
(setq pt (list (+ (car p0)(nth n tdlst))(- (cadr p0)(/ h 2))))
(vl-cmdf "text" "j" "mc" pt th 0 (nth n txt) "")
(setq n (1+ n))
)
(vl-cmdf "line" p0 (polar p0 0 w) "")
(vl-cmdf "array" (entlast) "" "r" (+ row 2) 1 (- h) "")
(vl-cmdf "line" p0 (polar p0 (* 1.5 pi)(* (1+ row) h)) "")
(foreach i cdlst (vl-cmdf "offset" i (entlast)(polar p0 0 w) ""))
(setq ss (ssget "x" '((0 . "*LINE,TEXT,ATTDEF"))))
(vl-cmdf "select" ss "r" ss0 "")
(setq ss3 (ssget "p"))
(setq A (rtos (* (getvar "CDATE") 1E8)))
(vl-cmdf "block" A p0 ss3 "")
(vl-cmdf "insert" A p0 "" "" "")
(setq aa (entlast))
(setq i 1 n 1)
(vl-cmdf "-color" "6" "")
(while (<= i row)
(setq j 0)
(while (< j 4)
(setq ipt (list (+ (car p0)(nth j tdlst))(- (cadr p0)(* i h)(/ h 2))))
(if (= j 0)
(addatttoblock aa th "" ipt (strcat "T" (itoa n))(itoa i))
(addatttoblock aa th "" ipt (strcat "T" (itoa n))
(strcase (getstring (strcat "\n" (nth j txt) ": "))))
)
(setq aa (entlast))
(setq n (1+ n))
(setq j (1+ j))
)
(setq i (1+ i))
)
(setvar "cecolor" "BYLAYER")
)
;
(defun addatttoblock (blk h prom ptatt tag v) ;25/08/03
(setq doc (vla-get-activedocument (vlax-get-acad-object))
obj (vlax-ename->vla-object blk)
ptblk (vlax-safearray->list
(vlax-variant-value (vla-get-insertionpoint obj)))
blkdef (vla-item (vla-get-blocks doc)(vla-get-name obj)))
(setq ptatt (vlax-3d-point (mapcar '- ptatt ptblk))
attdef (vla-addattribute blkdef h acAttributeModeverify prom ptatt tag v))
(vla-put-alignment attdef 10)
(vla-put-textalignmentpoint attdef ptatt)
(setq blkref (vla-insertblock
(vla-get-paperspace doc)
(vlax-3d-point ptblk)
(vla-get-name blkdef)
(vla-get-xscalefactor obj)
(vla-get-yscalefactor obj)
(vla-get-zscalefactor obj)
(vla-get-rotation obj)
)
)
(vla-delete obj)
(princ)
)
;
dbom : dialog { label = "Smart Bom Generator:";
: row {
: boxed_column {label="Arrow Type:";
: popup_list {key="ttype"; edit_width =11;}
}
: column {
: edit_box {label = "DisofRow:"; key = "h"; value="0.197"; edit_width = 4;}
: edit_box {label = "TextHeight:"; key = "th"; value="0.08"; edit_width = 4;}
}
}
spacer;
: text_part {label="Width of Columns:";}
:row {
: boxed_column {label = "Col1";
: edit_box { key = "c1"; value="0.394"; edit_width = 4;}
}
: boxed_column {label = "Col2";
: edit_box { key = "c2"; value="1.26"; edit_width = 4;}
}
: boxed_column {label = "Col3";
: edit_box { key = "c3"; value="0.952"; edit_width = 4;}
}
: boxed_column {label = "Col4";
: edit_box { key = "c4"; value="0.394"; edit_width = 4;}
}
}
spacer;
: row {
: button {label="Pick Points for Parts"; key="pick"; }
cancel_button;
}
: row {
: image { key = "im" ; width = 4; fixed_width= true;}
: paragraph {
: text_part { label = "Designed and Created"; alignment=right;}
: text_part { label = "by Richard Liang"; alignment=right;}
}
}
}
[/PHP]
广告位,后台可以设置,支持js
您好,您暂时不能浏览帖子的全部内容,请 登录
| 没有账号? 请 注册