I have a dynamic blocks with attributes , which represent : the position of rebar quantity diameter and lenght of rebar ,
I have to detail the curved rebars , so if can somebody help me with this ;
Here I found a some lisp , maybe it could be useful:
(defun c:PLab (/ obj)
;; Label each LWPolyline segment with number and distance
;; Alan J. Thompson, 04.21.10 / 04.23.10
(vl-load-com)
(if (and (setq obj (car (entsel "\nSelect LWPolyline: ")))
(or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))
(alert "Invalid object!")
)
(setq obj (vlax-ename->vla-object obj))
)
((lambda (n l s / d)
(while (nth (1+ (setq n (1+ n))) l)
((lambda (a b / dist)
(setq dist (abs (- (setq d (vlax-curve-getDistAtPoint obj a))
(vlax-curve-getDistAtPoint obj b)
)
)
)
((lambda (p)
((lambda (text)
(vla-put-AttachmentPoint text 8)
(vla-put-InsertionPoint text p)
;; (vla-put-Rotation text (angle a b))
((lambda (ang)
(if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))
(vla-put-rotation text (+ pi ang))
(vla-put-rotation text ang)
)
)
(angle a b)
)
)
(vla-AddMText s p 0.30 (strcat (itoa (1+ n)) " - " (rtos dist)))
)
)
(vlax-3d-point (vlax-curve-getPointAtDist obj (+ (/ dist 2.) d)))
)
)
(nth n l)
(nth (1+ n) l)
)
)
)
-1
(AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2)
(if (or (eq acmodelspace
(vla-get-activespace
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
)
(eq :vlax-true (vla-get-mspace *AcadDoc*))
)
(vla-get-modelspace *AcadDoc*)
(vla-get-paperspace *AcadDoc*)
)
)
)
(princ)
)
;;; Group items in list based on specified number
;;; L - List to process
;;; # - Number of items for grouping
;;; Alan J. Thompson, 03.26.10
(defun AT:ListGroupByNumber (L # / n g f)
(setq n -1)
(while (> (1- (length L)) n)
(repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))
(setq f (cons (reverse g) f)
g nil
) ;_ setq
) ;_ while
(reverse f)
) ;_ defun
second one :
(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" 8))
(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 "_" 8) (vlax-make-variant el 8))
)
(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)
) Thanks in advance
