Leaderboard

Hello friends, I recently was thinking on how to entmake an arc with 2 points and a radius, and since I couldn't find a solution without knowing the center point created this solution by using a lwpolyline, I don't know if it ever is useful for you or not, but if it ever happens to be useful to you give me a like or just credit. ;;; Program to create a curved lwpolyline with 2 points and a radius ;;; By Isaac A. 20220523 ;;; V1.1 (defun c:parc (/ bcal cw end r start) (while (= nil (setq start (getpoint "\nPick the start point"))) (setq start (getpoint "\nPick the start point")) ) (while (= nil (setq end (getpoint "\nPick the end point"))) (setq end (getpoint "\nPick the end point")) ) (setq r (getreal "\nGive me the radius: ")) (while (< r (/ (distance start end) 2.)) (setq r (getreal (strcat "\nThe radius can't be less than " (rtos (/ (distance start end) 2.) 2 2) ": "))) ) (setq bcal (ia:bulge start end r)) (initget 1 "Clockwise counterclockWise") (setq cw (getkword "\nSelect the path of the arc Clockwise/counterclockWise: ")) (if (= cw "Clockwise") (setq bcal (* -1 bcal)) ) (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(8 . "newlayer") '(62 . 5) '(38 . 0.0) (cons 90 2) '(70 . 0) (cons 10 start) (cons 42 bcal) (cons 10 end) '(42 . 0.) ) ) (princ) ) ;;; ia:bulge Obtains the bulge to be used on a curved lwpolyline ;;; based on 2 points and radius (defun ia:bulge (p1 p2 r / d d-2 d-4 n) (setq d (distance p1 p2)) (if (>= r (/ d 2)) (progn (setq n (/ d (* 2. r)) d-2 (cond ((equal n 1. 1e-9) (/ pi 2.)) ((equal n -1. 1e-9) (/ pi -2.)) ((< -1. n 1.) (atan n (sqrt (- 1 (expt n 2)))) ) ) d-4 (/ d-2 2.) ) (/ (sin d-4) (cos d-4)) ) (princ "\nThe radius is incorrect") ) ) Hoping it ever gets useful to anyone. Happy coding.

If the radius is less than the distance between the points, then there will be an emergency exit. Therefore, it is necessary to check for the minimum value of the radius. Sorry for my English. bulge.lsp

This is not a normal route, so I don't know if it's possible I just simply thought about it. how about to make routine like this 1. copy block 2. create a new empty drawing 3. paste block 4. rename their layers 5. rename blocks 6. copy and paste them back into the original drawing. generally lisp only works in one drawing, so you'll have to divide it in half to write a routine, or find another way. nested blocks and dynamic blocks are beyond my learning scope, so I am not sure.

This was also an opportunity to keep the code simple. (command "_.arc" "_non" p1 "_e" "_non" p2 "_radius" rad) (command "_.chprop" "_last" "" "_color" 9 "")

your great.........this is awesome.

Thanks... Note : You don't need starting (vl-load-com) as all further coded functions are not (vl-load-com) dependent... Second : I like your way of formulating (getkword) in relation to CW/CCW : [Clockwise/counterclockWise]... If I bump to something in future, I may steal your reasoning/visualization... I see you got like(s), so perhaps sometimes it's good thing to be modest/humble (here on planet) and not asked to be feeded with too much personality/egoistc glorifications (you could end up with empty hands on other/next world/planet (after this/thankful life of wonders...))...

It is interesting as it is like generating a serial code number. or looks like a temporary number is created in PASTEBLOCK with ctrl+shifth+v. Tharwat has made a simple way to find unused block names in links using tblsearch. replace 1~3 with wblock, then write the name of the unused block in the dwg file name in same directory. and then process then import it again. perhaps in this case i should think about how to apply this to nested blocks. like BLOCK1_SUB1, BLOCK1_SUB2... or your method may be better.

I reused a little trick making small selection sets at the ends of the polyline to get the plot number and xfmr size. https://www.cadtutor.net/forum/topic/75207-count-number-of-polylines-near-other-polylines/ So the only thing you will have to select is the polyline and the attribute block you want to update. if the area of pt1 and pt2 is too small (nothing is selected) it will prompt you to manually select them. This happens in plot 10 & 11 of your example drawing. You will have to update the lengths to set the wire sizes #### in the lisp another "error" that i saw is plot 5 polyline is 40' short. So i added highlighting the polyine at the end to for visual confrontation. so keep an eye out. (defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire) (while (setq poly (vlax-ename->vla-object (setq e (car (entsel "\nSelect Polyline"))))) (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round to nearest 10' add 15' (setq spt (vlax-curve-getStartPoint poly)) (setq pt1 (mapcar '- spt '(30 30))) (setq pt2 (mapcar '+ spt '(30 30))) ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window (cond ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1)) (setq lot (cdr (assoc 1 (entget (ssname ss 0))))) ) ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SST) 1)) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA")) ) ) (setq SST nil SSX nil) (setq ept (vlax-curve-getendpoint poly)) (setq pt1 (mapcar '- ept '(30 30))) (setq pt2 (mapcar '+ ept '(30 30))) ;(vl-cmdf "_rectangle" "_non" pt1 "_non" pt2) ;uncomment to see selection window (cond ((and (setq SSX (ssget "C" pt1 pt2 '((0 . "INSERT") (2 . "HOTDOG_TX_N-2006")))) (= (sslength SSX) 1)) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (ssname SSX 0)) "KVA")) ) ((and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1)) (setq lot (cdr (assoc 1 (entget (ssname ss 0))))) ) ) (if xfmr (progn) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA")) ) (if lot (progn) (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number")))))) ) (cond ((and (eq xfmr "25 KVA") (<= len ###)) (setq wire "WIRE 1/0") ) ((and (eq xfmr "25 KVA") (<= len ###)) (setq wire "WIRE 4/0") ) ((and (eq xfmr "25 KVA") (> len ###)) (setq wire "ERROR") ) ((and (eq xfmr "50 KVA") (<= len ###)) (setq wire "WIRE 1/0") ) ((and (eq xfmr "50 KVA") (<= len ###)) (setq wire "WIRE 4/0") ) ((and (eq xfmr "50 KVA") (> len ###)) (setq wire "ERROR") ) ((and (eq xfmr "75 KVA") (<= len ###)) (setq wire "WIRE 1/0") ) ((and (eq xfmr "75 KVA") (<= len ###)) (setq wire "WIRE 4/0") ) ((and (eq xfmr "75 KVA") (> len ###)) (setq wire "ERROR") ) ) (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: ")))) (progn (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'")) (LM:vl-setattributevalue blk "WIRE" wire) (LM:vl-setattributevalue blk "LOT_NUM" lot) ) ) (command "_.Regen") (sssetfirst nil (ssadd e)) ) ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue ( blk tag ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue ( blk tag val ) (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val) ) ) (vlax-invoke blk 'getattributes) ) )

@exceed It has to be a completely different name. If you insert a block from another drawing by copy and paste even tho it has different layers/colors/entity's if their is already a block with that name in the block library then AutoCAD uses the defined block. --edit--oops missed step 5 Ask me how I know that? about 4-5 years ago we would just make quick blocks named block-1, block-2, block-3... everything was fine for about 2 months then someone was like "ill take a block from this drawing and put it into this drawing". messed up about a weeks worth of work because the profiles were different enough that the material we were cutting was unusable. but not so different that when you pasted the block you noticed a difference. Why I use this in my quick block lisp ;;;======================================================================== ;;; *** AUTO-BLOCK.LSP *** ;;; BLOCK CREATION ON THE FLY : "Just select your objects" ;;; By Raymond RIZKALLAH, October/2004 ;;;======================================================================== (defun Set_BlkName () (setq o-dmzn (getvar "dimzin")) (setvar "dimzin" 0) (setq c-date (getvar "cdate")) (setq w-all (rtos c-date 2 20)) ;; >> "20041022.11423489" (setq w-yr (substr w-all 3 2)) ;; ["01" to "99"] >> "04" (setq w-mn (substr w-all 5 2) ;; ["A" to "L"] >> "J" w-mn (chr (+ 64 (read w-mn))) ;; ) (setq w-dy (substr w-all 7 2)) ;; ["A" to "Z" + "1" to "5"] >> "V" (if (<= (read w-dy) 26) ;; (setq w-dy (chr (+ 64 (read w-dy)))) ;; (setq w-dy (rtos (- (read w-dy) 26) 2 0)) ;; ) (setq w-hr (substr w-all 10 2) ;; ["A" to "S"] >> "K" w-hr (chr (+ 64 (read w-hr))) ;; ) (setq w-mt (strcat (substr w-all 12 1) "-" (substr w-all 13 1))) ;; ["00" to "59"] >> "4-2" (setq w-sc (substr w-all 14 2)) ;; ["00" to "59"] >> "34" (setq w-mm (substr w-all 16 2)) ;; ["00" to "59"] >> "89" (setq blkname (strcat "$" w-mn w-sc w-hr w-mt w-dy w-yr w-mm)) ;; >> "$J34K4-2V0489" (setvar "dimzin" o-dmzn) (princ) )

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/i-need-a-lisp-for-polyline-labeling/td-p/6813007

Precisely .. quick example for OP: (if (setq e (car (nentsel))) (progn (vla-put-color (vlax-ename->vla-object e) 3) (command "_.regen")) )

That's not how blocks work. you can have a dynamic block that changes shape or attributes that can change. but once you start changing the layer or other core proprieties that affect goes to all blocks sharing that name. you would essentially have to explode and remake the block and all nested blocks under a different name and then join them back in the same order.

Assuming you are using a version of AutoCAD in which the LAYISO command is available as standard, try the following: (defun c:mylayiso ( / lay sel ) (setq lay "layer1,layer2,layer3") (if (setq sel (ssget "_X" (list (cons 8 lay) (if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model"))))) (command "_.layiso" sel "") ) (princ) ) You can then use the LAYUNISO command to unisolate the layers.