Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/22/2023 in all areas

  1. Quick answer put the rectangs on another layer same with the mlines then use layiso so only correct objects are selected. Then the ssget can filter by layer also. OR (defun c:cuts ( / ) (command "chprop" (ssget "x" '((0 . "MLINE"))) "" "la" "Footlayer" "") (command "-layer" "M" "DIMS" "") (command "chprop" (ssget "x" '((0 . "DIMENSION"))) "" "la" "DIMS" "") (setvar 'clayer "Footlayer") (command "-layer" "OFF" "*" "n" "") (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ss (ssget '((0 . "lwpolyline")))) (if ss (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (1- x)))) (setq obj (vlax-ename->vla-object ent)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq co-ord (cons (last co-ord) co-ord)) (command "offset" 10 ent (getvar 'extmax) "") (setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast))))) (setq co-ord2 (cons (last co-ord2) co-ord2)) (entdel (entlast)) (setq ss2 (ssget "f" co-ord2 '((0 . "MLINE")))) (setq mpts '()) (repeat (setq j (sslength ss2)) (setq ent2 (ssname ss2 (setq j (1- j)))) (setq obj2 (vlax-ename->vla-object ent2)) (setq intpts (vlax-invoke obj 'intersectWith obj2 acExtendThisEntity)) (setq mp (mapcar '* (mapcar '+ (list (nth 0 intpts) (nth 1 intpts) 0.0)(list (nth 3 intpts) (nth 4 intpts) 0.0)) '(0.5 0.5 0.5))) (setq mpts (cons mp mpts)) ) (command "trim" ss2 "") (foreach pt mpts (command pt) ) (command "") ) (alert "no plines") ) (command "Layer" "on" "*" "") (princ) ) (c:cuts)
    1 point
  2. Manually trim select mline then pick point at midpoint of each side of red plines seems to work. So get all rectangs do a offset and get te co-ords of that new pline then use ssget "F" to get the touching mlines, the trim point is mid of the 2 mlines points. ; https://www.cadtutor.net/forum/topic/77526-how-to-trim-the-intersected-line-between-mline-polyline/ ; Trim mlines touching plines ; by AlanH May 2023 (defun c:cuts ( / ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ss (ssget '((0 . "lwpolyline")))) (if ss (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (1- x)))) (setq obj (vlax-ename->vla-object ent)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq co-ord (cons (last co-ord) co-ord)) (command "offset" 10 ent (getvar 'extmax) "") (setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast))))) (setq co-ord2 (cons (last co-ord2) co-ord2)) (entdel (entlast)) (setq ss2 (ssget "f" co-ord2 '((0 . "MLINE")))) (setq mpts '()) (repeat (setq j (sslength ss2)) (setq ent2 (ssname ss2 (setq j (1- j)))) (setq obj2 (vlax-ename->vla-object ent2)) (setq intpts (vlax-invoke obj 'intersectWith obj2 acExtendThisEntity)) (setq mp (mapcar '* (mapcar '+ (list (nth 0 intpts) (nth 1 intpts) 0.0)(list (nth 3 intpts) (nth 4 intpts) 0.0)) '(0.5 0.5 0.5))) (setq mpts (cons mp mpts)) ) (command "trim" ss2 "") (foreach pt mpts (command pt) ) (command "") ) (alert "no plines") ) (princ) ) (c:cuts)
    1 point
  3. oops forgot to wrap it in itoa (princ (strcat "\n" (itoa (sslength SS)) " Objects Copied to layer " layerName2 "."))
    1 point
  4. This should do the trick. tho like usual @ronjonp's is better. (defun c:nc (/ LastEnt SS layerName2) (setq LastEnt (entlast)) ;Sets a place maker anything created, copied, or moved will end up in the selection SS (setq SS (ssadd)) (command "_.ncopy" (while (< 0 (getvar 'CMDACTIVE)) (command pause)) "" "_non" '(0 0) "_non" '(0 0)) ;above keeps pausing allowing The user to make multiple selections. have to right click to exit. ;(setq lay (cdr (assoc 8 (entget (entlast))))) ;(setq layerName1 "layerName1") (setq layerName2 "C-NPLT") ;check if layer exist else make new layer. (or (tblsearch "LAYER" layerName2) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 7)))) ;change 62 value for color (while (setq LastEnt (entnext LastEnt)) ;adds entitys to selection set SS (ssadd LastEnt SS) ) (command "_.chprop" SS "" "LA" layerName2) ; Change layer of the copied object(s) (princ (strcat "\n" (itoa (sslength SS)) " Objects Copied to layer " layerName2 ".")) )
    1 point
  5. ncopy isn't in BricsCAD so I couldn't test this. (defun c:nc (/ layerName2) (command "_.ncopy" "\\" "" "_non" '(0 0) "_non" '(0 0)) ;ncopy command with a pause for user selection. assumes you can select only one thing at a time. ;(setq lay (cdr (assoc 8 (entget (entlast))))) ;(setq layerName1 "layerName1") (setq layerName2 "C-NPLT") ;check if layer exist else make new layer. (or (tblsearch "LAYER" layerName2) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 layerName2) '(70 . 0) '(62 . 7)))) ;change 62 value for color (command "_.chprop" (entlast) "" "LA" layerName2) ; Change layer of the copied object(s) (princ (strcat "\nObject Copied to layer " layerName2 ".")) )
    1 point
×
×
  • Create New...