钢筋去鳞
我有一个带有属性的动态块，它表示：钢筋数量、直径和钢筋长度的位置，我必须详细说明弯曲钢筋，如果有人可以帮助我这一点；
在这里，我找到了一个法语ISP，也许它会有用：
(vl-load-com)
(defun c:mult-info_po2cell ( / js obj ename n AcDoc Space pr nb lst_id-seg lst_pt lst_length lst_alpha lst_rad id all_path j end_pos id_path fonts_path file_shx
nw_obj nw_style dist_start dist_end pt_start pt_end seg_len seg_bulge rad alpha oldim oldlay h_t w_c ename_cell n_row n_column)
(princ "\nSelect polylines.")
(while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
(princ "\nSelection empty, or is not a available polyline!")
)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(cond
((null (tblsearch "LAYER" "Table-Polyline"))
(vla-add (vla-get-layers AcDoc) "Table-Polyline")
)
)
(cond
((null (tblsearch "STYLE" "Text-Cell"))
(setq all_path (getenv "ACAD") j 0)
(while (setq end_pos (vl-string-position (ascii ";") all_path))
(setq id_path (substr all_path 1 end_pos))
(if (wcmatch (strcase id_path) "*FONTS*")
(setq fonts_path (strcat id_path "\\"))
)
(setq all_path (substr all_path (+ 2 end_pos)))
)
(setq file_shx (getfiled "Select a font file " fonts_path "shx" )
(if (not file_shx)
(setq file_shx "txt.shx")
)
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Cell"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
)
(command "_.ddunits"
(while (not (zerop (getvar "cmdactive")))
(command pause)
)
)
)
)
(setq
oldim (getvar "dimzin")
oldlay (getvar "clayer")
)
(setvar "dimzin" 0) (setvar "clayer" "Table-Polyline")
(initget 9)
(setq ins_pt_cell (getpoint "\nLeft-Up insert point of table: "))
(initget 6)
(setq h_t (getdist ins_pt_cell (strcat "\nHigth text <" (rtos (getvar "textsize")) ">: ")))
(if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
(initget 7)
(setq w_c (getdist ins_pt_cell "\nWidth of cells: "))
(setq
lst_id-seg '()
lst_pt '()
lst_length '()
lst_alpha '()
lst_rad '()
nb 0
id 0
)
(repeat (setq n (sslength js))
(setq
obj (ssname js (setq n (1- n)))
ename (vlax-ename->vla-object obj)
pr -1
id (1+ id)
)
(repeat (fix (vlax-curve-getEndParam ename))
(setq
dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
pt_start (vlax-curve-GetPointAtParam ename pr)
pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
seg_len (- dist_end dist_start)
seg_bulge (vla-GetBulge ename pr)
rad (if (zerop seg_bulge) 0.0 (/ seg_len (* 4.0 (atan seg_bulge))))
alpha (if (zerop seg_bulge) (angle pt_start pt_end) 0.0)
lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg)
lst_pt (cons pt_start lst_pt)
lst_length (cons seg_len lst_length)
lst_rad (cons (abs rad) lst_rad)
lst_alpha (cons alpha lst_alpha)
nb (1+ nb)
)
)
(if (eq (vla-get-closed ename) :vlax-false)
(setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa nb)) lst_id-seg))
(setq lst_id-seg (cons (strcat "P" (itoa id) "-" (itoa (- nb (fix (vlax-curve-getEndParam ename))))) lst_id-seg))
)
(setq
lst_pt (cons pt_end lst_pt)
lst_length (cons 0.0 lst_length) lst_rad (cons 0.0 lst_rad) lst_alpha (cons 0.0 lst_alpha)
nb (1+ nb)
)
)
(mapcar
'(lambda (p tx)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point p)
0.0
tx
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list 5 h_t 5 p "Text-Cell" "Table-Polyline" 0.0)
)
)
lst_pt
lst_id-seg
)
(vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 2 nb) 6 (+ h_t (* h_t 0.25)) w_c)
(setq ename_cell (vlax-ename->vla-object (entlast)) n_row (1+ nb) n_column -1)
(vla-SetCellValue ename_cell 0 0
(vlax-make-variant
(strcat "Summary of " (itoa (sslength js)) " LWPOLYLINES")
8
)
)
(vla-SetCellTextStyle ename_cell 0 0 "Text-Cell")
(vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
(vla-SetCellAlignment ename_cell 0 0 5)
(foreach n
(mapcar'list
(append lst_id-seg '("N°"))
(append (mapcar 'rtos (mapcar 'car lst_pt)) '("Coordinates X"))
(append (mapcar 'rtos (mapcar 'cadr lst_pt)) '("Coordinates Y"))
(append (mapcar 'rtos lst_length) '("Lengths"))
(append (mapcar 'angtos lst_alpha) '("Directions"))
(append (mapcar 'rtos lst_rad) '("Radius"))
)
(mapcar
'(lambda (el)
(vla-SetCellValue ename_cell n_row (setq n_column (1+ n_column))
(if (or (eq (rtos 0.0) el) (eq (angtos 0.0) el)) (vlax-make-variant "_"(vlax-make-variant el )
)
(vla-SetCellTextStyle ename_cell n_row n_column "Text-Cell")
(vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
(if (eq n_row 1)
(vla-SetCellAlignment ename_cell n_row n_column 5)
(vla-SetCellAlignment ename_cell n_row n_column 6)
)
)
n
)
(setq n_row (1- n_row) n_column -1)
)
(setvar "dimzin" oldim) (setvar "clayer" oldlay)
(prin1)
)
提前感谢！！！
希望能帮上忙！！！
钢筋详图更新。图纸 你有想要什么的例子吗？ 最终结果是在绿色矩形中，在我绘制的图形中
红色多段线表示钢筋，我想转到表中的每条多段线的对齐尺寸，但如果可行，则表中的数字from dimension应除以10（例如94=90；95=100；96=100），就像我手动键入它们一样，也应该在表中加入每个具有属性的块的属性标记，，，，，，（也像我在绿色矩形中制作的一样）
P、 S.表格可以没有第二列（Schita=表格中没有插入块）
也忘了提到R=半径
页:
[1]