Leaderboard

Thanks guys, will play with these today

A question for Bear, is the shape always ortho line work ie 0 90 180 270 with arcs. May be a real quick solution.

Maybe 1 big pline and walk along, or just pline the short segments, that would be my 1st go. Try this, pick a square around the arc when asked it does 1 arc at a time, reasonably fast. (defun c:wow ( / pt1 pt2 pt3 ss num ) (while (setq pt1 (getpoint "\nPick 1st corner point of short lines Enter to exit")) (setq pt2 (getcorner pt1 "\Pick other corner of short lines ")) (setq ss (ssget "WP" (list pt1 pt2) '((0 . "LINE")))) (setq num (/ (sslength ss) 2)) (command "pedit" (ssname ss num) "Y" "JOIN" ss "" "") (setq arcpl (entlast)) (setq co-ords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget arcpl)))) (setq num (/ (length co-ords) 2)) (setq pt1 (car co-ords)) (setq pt2 (nth num co-ords)) (setq pt3 (last co-ords)) (command "arc" pt1 pt2 pt3) (command "erase" arcpl "") ) (princ) ) (c:wow) Big NOTE, when picking the double curve make a box that does not cross the second arc it will make 2 arcs delete the lines in the gap and do fillet r 0 or use the radius. I may add that as a separate function. As we now know the radius.

Not sure what to say, tested again against 1.dwg, I did though do "Textsize" 150 1st. If you want to repeat change wow to c:wow or a name you want to use but add the C :. Are you sure it did not work but text maybe tiny.

A variation of Steven P code (defun myblkbylayer( / lyr lname) (setvar 'ctab "Model") (vlax-for lyr (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (setq lname (vla-get-name lyr)) (setq ss (ssget "X" (list (cons 8 lname)))) (command "-block" lname "0,0,0" ss "") ) (princ) ) (myblkbylayer) I would add lee-mac get bounding box multiple objects that way can make insert point lower left of objects.

This took a bit longer than I hoped - but an interesting puzzle (though of course, it is obvious what to do now) It should find lines that connect together to make an arc. If 3 or more lines have a perpendicular line that intersect at nearly the same point this assumes they are straight segments to form an arc. Straight lines are deleted, arc takes their place. Command: foo --EDIT-- will get up set if 2 consecutive lines are colinear.. I'll think about that (defun ConnectedArc ( MyEnt / Int1 Int2 MySS MyList MyLines acount pt pt1 pt2 pt3 pt4 ConnectedLines LineSS) ;;returns selection set of lines sharing a common perpendicular line intersection point ;;sort of, includes fuzz factor ;;Sub functions (defun DrawLine (pt1 pt2) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) ))) ; draws a line (defun mid-pt ( p1 p2 / ) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) ) ) ; mid point p1 to p2 (defun LM:intersections ( ob1 ob2 mod / lst rtn ) ; Intersection between 2 lines (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;;End Sub functions (setq FF 0.001) ; Fuzz factor 0.1%. Proportion of the lengths (setq LineSS (ssadd)) ; Blank selection set (setq ConnectedLines (ssadd MyEnt)) ; List for lines connected to selected (setq MyList (ssadd MyEnt)) ; List of lines (setq Pt (cdr (assoc 10 (entget MyEnt)))) ; End A point (setq AnEnt MyEnt) ; Starting Entity (setq Pt1 (cdr (assoc 10 (entget MyEnt)))) ; End A point (setq Pt2 (cdr (assoc 11 (entget MyEnt)))) ; End B point (setq MyEntLen (distance Pt1 Pt2)) ; Distance for fuzz factor (setq PtA (mapcar '+ (list (* FF MyEntLEn -1) (* FF MyEntLEn -1)) Pt1)) ; Small area around end of line (setq PtB (mapcar '+ (list (* FF MyEntLEn) (* FF MyEntLEn)) Pt1)) ; Other small area around end of line (setq MySS (ssget "_C" PtA PtB '((0 . "LINE"))) ) ; select joining lines within 0.0001 (if (= (sslength MySS) 1) ; If only 1 joining lines, try other end (progn (setq PtA (mapcar '+ (list (* FF MyEntLEn -1) (* FF MyEntLEn -1)) Pt2)) ; Small area around end of line (setq PtB (mapcar '+ (list (* FF MyEntLEn) (* FF MyEntLEn)) Pt2)) ; Other small area around end of line (setq MySS (ssget "_C" Pt1A Pt1B '((0 . "LINE")))) ; select joining lines within 0.0001 ) ) (if (= (sslength MySS) 2) ; Find one adjacent intersection point (progn (setq acount 0) (repeat 2 (setq IntEnt (ssname MySS acount)) (setq PtA (cdr (assoc 10 (entget IntEnt)))) ; next line end points (setq PtB (cdr (assoc 11 (entget IntEnt)))) (setq MidPt (mid-pt PtA PtB)) (setq MyAng (angle PtA PtB)) (setq PtC (polar MidPt (- MyAng (/ pi 2)) 1000)) (setq LineSS (ssadd (DrawLine MidPt PtC) LineSS )) (setq acount 1) ) ; end repeat (setq Int1 (LM:intersections ; Intersection / origin of arc; car: Only 1 intersection (vlax-ename->vla-object (ssname LineSS 0)) (vlax-ename->vla-object (ssname LineSS 1)) acextendboth)) (setq MyRadius (distance (car Int1) Pt1)) ; Radius of arc ) ) (repeat 2 ; Repeat2 - both directions (setq StopLoop "No") ; Marker to stop looping (while (= StopLoop "No") (setq Pt1 (mapcar '+ (list (* FF MyEntLEn -1) (* FF MyEntLEn -1)) Pt)); Small area around end of line (setq Pt3 (mapcar '+ (list (* FF MyEntLEn) (* FF MyEntLEn)) Pt)); Other corner (setq MySS (ssget "_C" Pt1 Pt3 '((0 . "LINE"))) ) ; select joining lines within 0.0001 (if (= (sslength MySS) 2) ; If only 2 joining lines (progn (setq MySS (ssdel AnEnt MySS)) ; Next line (setq AnEnt (ssname MySS 0)) ; next line entity name (if (ssmemb AnEnt ConnectedLines) (progn (princ "Repeating Selection") (setq StopLoop "Yes") ) (progn (setq APtA (cdr (assoc 10 (entget AnEnt)))) ; next line end points (setq APtB (cdr (assoc 11 (entget AnEnt)))) ; next line end points (setq MidPt (mid-pt APtA APtB)) (setq MyAng (angle APtA APtB)) (setq PtC (polar MidPt (- MyAng (/ pi 2)) 1000)) (setq LineSS (ssadd (setq NewLine (DrawLine MidPt PtC)) LineSS )) (setq Int2 (LM:intersections ; Intersection / origin of arc (vlax-ename->vla-object (ssname LineSS 0)) (vlax-ename->vla-object NewLine) acextendboth)) (if (equal (car Int1) (car Int2) (* FF MyRadius)) (progn (setq ConnectedLines (ssadd AnEnt ConnectedLines)) ; add next line to list ) ; end progn (progn (setq StopLoop "Yes") ) ; end progn ) ; end if intersection match (if (equal APtA Pt (* FF MyEntLEn)) (setq Pt APtB)(setq Pt APtA) ; work out if next line connected at end A or B ) ; end if ) ; end progn ) ; end if in connected lines list ) ; end progn (progn (setq StopLoop "Yes") ) ; end progn ) ; end if SSlength = 2 ) ; end while stoploop (setq Pt (cdr (assoc 11 (entget MyEnt)))) (setq AnEnt MyEnt) ) ; end repeat (setq acount 0) (repeat (sslength LineSS) ; delete temporary lines. Use entdel to keep command line quiet (entdel (ssname LineSS acount)) (setq acount (+ acount 1)) ) ; (princ "\n")(princ (sslength ConnectedLines))(princ " Connected Lines Found") (list ConnectedLines (car Int1) MyRadius) ; Return Connected Lines ) (defun c:foo (/ thisdrawing ArcSS i MyEnt MyArc MySS MyList p1 p2 p3) ;;sub functions (defun onlyunique ( MyList / returnList ) (setq ReturnList (list)) ; blank list for result (foreach n MyList ; loop through supplied list (if ( = (member n (cdr (member n MyList))) nil) ; if list item occurs only once (setq ReturnList (append ReturnList (list n))) ; add to list ) ) ; end foreach ReturnList ) (defun uniquepoints ( MySS / MyList acount) (princ "Select Lines") (setq MyList (list)) ; Blank list for line coordinates (setq acount 0) (while (< acount (sslength MySS)) ; loop each line (setq MyEnt (entget (ssname MySS acount))) (setq MyList (append MyList (list (cdr (assoc 10 MyEnt))))) ; add end A to list (setq MyList (append MyList (list (cdr (assoc 11 MyEnt))))) ; add end B to list (setq acount (+ acount 1)) ) (list (onlyunique MyList) MyList) ; list: Unique Items, All Items ) (defun LM:3pcircle ( pt1 pt2 pt3 / cen md1 md2 vc1 vc2 ) (if (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2) md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3) vc1 (mapcar '- pt2 pt1) vc2 (mapcar '- pt3 pt2) cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0)) md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0)) nil ) ) (list cen (distance cen pt1)) ) ) (defun 3parc ( pt1 pt2 pt3 / lst ocs pt1 pt2 pt3 ) ; Lee Mac (if (setq ocs (trans '(0 0 1) 1 0 t)) (if (setq lst (LM:3pcircle pt1 pt2 pt3)) (progn (if (minusp (sin (- (angle pt1 pt3) (angle pt1 pt2)))) (mapcar 'set '(pt1 pt3) (list pt3 pt1)) ) (entmakex (list '(000 . "ARC") (cons 010 (trans (car lst) 1 ocs)) (cons 040 (cadr lst)) (cons 050 (angle (trans (car lst) 1 ocs) (trans pt1 1 ocs))) (cons 051 (angle (trans (car lst) 1 ocs) (trans pt3 1 ocs))) (cons 210 ocs) ) ) ) (princ "\nPoints are collinear.") ) ) (princ) ) (defun LM:ss-union ( lst / out ) (setq lst (vl-sort lst '(lambda ( a b ) (> (sslength a) (sslength b)))) out (car lst) ) (foreach ss (cdr lst) (repeat (setq i (sslength ss)) (ssadd (ssname ss (setq i (1- i))) out) ) ) out ) ;;end sub functions ;;'Main' stuff apart from the functions above (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark thisdrawing) ; Start Undo (setq ArcSS (ssget '((0 . "LINE")))) ; Selection Set (setq ArcLines (ssadd)) ; List for lines contained in an arc (setq ArcSSCount 0) ; A counter (while (< ArcSSCount (sslength ArcSS)) ; while loop (setq MyEnt (ssname ArcSS ArcSSCount)); Next entity in loop (if (ssmemb MyEnt ArcLines) ; If entity is in an arc.... (progn ; do nothing ) (progn (setq MyArc (ConnectedArc MyEnt)) ; Find all lines connected that are in an arc (setq MySS (car MyArc)) ; Entities that make arc (if (< 3 (sslength MySS)) ; If more than 3 entities its an arc. Can change 3 to suit (progn (setq MyList (uniquepoints MySS)) ; car: unique points, cadr: points list (setq ArcLines (LM:ss-union (list ArcLines MySS))) ; add entities to ignore list (setq p1 (car (car MyList))) ; first unique point (setq p2 (nth (/ (length (cadr MyList)) 2) (cadr MyList))) ; point within the arc (setq p3 (cadr (car MyList))) ; second unique point (3parc p1 p2 p3) ; draw arc ) ; end progn ) ; end if arc returned ) ; end progn ) ; end if entity in an arc (setq ArcSSCount (+ ArcSSCount 1) ) ; Increase count ) ; end while (setq acount 0) (repeat (sslength ArcLines) ; delete arc lines. Use entdel to keep command line quiet (entdel (ssname ArcLines acount)) (setq acount (+ acount 1)) ) (vla-endundomark thisdrawing) ; end undo (princ) ) Happy for you all to break it, improve it, pull it to pieces - it can be improved I think. There was a question a while ago very similar problem with a polyline converted from a spline. I think the collective we removed the points of the straight segments but each point along any curves were left as short points from the spline. I think this can be changed to convert old spline line segments in to single arcs and then onto remake as a polyline. Worth doing this because the polyline thing would be handy.

I use this for some routines which returns a list of layers (defun getmylayerlist ( / lyr mylayers) (vlax-for lyr (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (setq mylayers (cons (vla-get-name lyr) mylayers)) ) mylayers ) and this is another (Lee Mac I think) (defun LayLiast ( / lay lst) (while (setq lay (tblnext "layer" (null lay))) (setq lst (cons (cdr (assoc 2 lay)) lst)) ) lst ) I think I have another couple of versions Both return the layers as a list, so can do maybe a while or, foreach loops Obviously (...) for your selection set you need to change the ' for list so that the layer name will be evaluated in the filter (setq --LayerName-- "0") ; set layer name as 0 as an example (setq sel1 (ssget "x" (list (cons 8 --LAYERNAME-- )))) Does that help?

Hi @barristann, So sorry about the huge delay... I haven't been in this site for so long, so I'm grateful to those who resolved your issues first before I get a chance to come back. I've made some improvements to the function while I was away, so here's the new one, with the following enhancements: List of lists can now take any data type (integers, reals, etc) Column width adjustment enhancement when blocks are inserted. ;; JH:list-to-table --> Jonathan Handojo ;; Creates a table from a list of lists of strings ;; space - ModelSpace or Paperspace vla object. ;; lst - list of lists where each list is a list of items to put into the table ;; => Can be any data type: string, integer, real, etc. ;; => if you wish to insert a block in the cell, specify the block name and prefix using "<block>" ;; => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1" ;; pt - Insertion point of table (a list of 2 or 3 real numbers) ;; tblstyle - Table style to use, or nil to use the current table style ;; => If table style does not exist, uses current table style (defun JH:list-to-table (space lst pt tblstyle / blk blks hgt i j lens ncols rows totlen txt vtable) (setq ncols (apply 'max (mapcar 'length lst)) vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10) blks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) ) (vla-put-RegenerateTableSuppressed vtable :vlax-true) (or tblstyle (setq tblstyle (getvar "ctablestyle"))) (if (JH:TableStyle-p tblstyle) (vla-put-StyleName vtable tblstyle)) (repeat (setq i (length lst)) (setq rows (nth (setq i (1- i)) lst)) (vla-SetRowHeight vtable i (* 2.5 (vlax-invoke vtable 'GetCellTextHeight i 0))) (repeat (setq j (length rows)) (setq j (1- j) txt (vl-princ-to-string (nth j rows)) hgt (vlax-invoke vtable 'GetCellTextHeight i j) lens (cons (+ (abs (apply '- (mapcar 'car (textbox (list (cons 1 txt) (cons 40 hgt) (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j)) ) ) ) ) ) hgt ) lens ) ) (if (and (eq (strcase (substr txt 1 7)) "<BLOCK>") (tblsearch "block" (setq blk (substr txt 8))) ) (progn (if (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*") (vlax-method-applicable-p vtable 'setblocktablerecordid32) ) (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item blks blk))) (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item blks blk)) :vlax-true) ) (setq lens (cons hgt (cdr lens))) ) (vla-SetText vtable i j txt) ) ) (setq totlen (cons lens totlen) lens nil) ) (repeat ncols (vla-SetColumnWidth vtable (setq ncols (1- ncols)) (apply 'max (vl-remove nil (mapcar '(lambda (x) (nth ncols x)) totlen)) ) ) ) (vla-put-RegenerateTableSuppressed vtable :vlax-false) vtable ) ;; JH:TableStyle-p --> Jonathan Handojo ;; Checks if a table style exists in the current drawing (defun JH:TableStyle-p (sty) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_TABLESTYLE" ) sty ) ) ) ) )

Glad you got it working. A better way is to add the layout number as part of the list then you can update say 2-3 layouts rather than all by using layout number match, I started to write it that way but went the easy way 1st. (setq lst (list (list 1 "NAZIV CRTEŽA" "OSNOVA JAME") (list 2 "NAZIV_CRTEŽA" "PRESECI VOZNOG OKNA") .....))

Ok 1st thing the tag name is wrong in your posts. The tagname has an underscore. Any way try this idea. (defun c:upatt ( / lst x lays att atts obj) (setq lst (list (list "NAZIV CRTEŽA" "OSNOVA JAME") (list "NAZIV_CRTEŽA" "PRESECI VOZNOG OKNA") (list "NAZIV_CRTEŽA" "OSNOVA VRHA VOZNOG OKNA I DETALJ MONTAŽNE KUKE") (list "NAZIV_CRTEŽA" "DETALJ PRAGA VRATA") (list "NAZIV_CRTEŽA" "TEHNIČKE SPECIFIKACIJE") (list "NAZIV_CRTEŽA" "OSNOVA KABINE") (list "NAZIV_CRTEŽA" "PRESECI OPREME I RASPORED KONZOLA") (list "NAZIV_CRTEŽA" "PREGLED SIGURNOSNIH PROSTORA") (list "NAZIV_CRTEŽA" "POGLED PRISTUPNIH STRANA") ) ) (setq x 0) (setq lays (layoutlist)) (foreach val lst (setvar 'ctab (nth x lays)) (setq ss (ssget "x" (list (cons 0 "INSERT")(cons 2 "Pecat Marko Vukicevic")(cons 410 (getvar 'ctab))))) (setq obj (vlax-ename->vla-object (ssname ss 0))) (setq atts (vlax-invoke obj 'Getattributes)) (foreach att atts (if (= (vlax-get att 'tagstring) (car val)) (vlax-put att 'textstring (cadr val)) ) ) (setq x (1+ x)) ) (princ) ) (c:aupatts)

_layer new Roof color Truecolor 230,230,30 Roof set Roof rectangle 90,103100.558672044 14910,103649.948340055 _hatch Solid 90,103100.558672044 line 0,103100.558672044 0,103849.948340055 15000,103849.948340055 15000,103100.558672044 Try this, if you look at the command line you should see, that the hatch command is asking you to pick an object, so it only expects one coordinate (one of the corners is fine) otherwise you should tell it that you are going to use a window or fence. I laid out the script a bit differently it's easier to read and follow what is going on(and ignore my earlier comment about the semi colon that's for macro's)