Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/01/2023 in all areas

  1. A slightly different way, if all the texts are in the format "ABC (NxY)" and where the numbers could be any length. Returns anything after the first '(' MyString is the text string to change (if (setq MyPos (vl-string-search "(" MyString)) ; position of deliminator, ( (setq MyString (substr MyString (+ MyPos 1)) ) ; if contains "(" MyString ; If doesn't contain "(" )
    1 point
  2. Here is an example: (setq str "B1-X-(300x200)") (if (> (setq len (strlen str)) 8) (substr str (- len 8)) )
    1 point
  3. Another: (defun c:foo (/ n p s) (if (setq s (ssget '((0 . "LWPOLYLINE")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq n 0) (while (setq p (vlax-curve-getpointatparam e n)) (entmakex (list '(0 . "POINT") (cons 10 p))) (setq n (+ n 0.5)) ) ) ) (princ) )
    1 point
  4. @Steven P When I read this it reminded me of something i came across in visual lisp. the funcion vlax-invoke with 'explode does explode the selected item into individual entity's. but it also leaves the original too. this builds off that and takes the start point and mid point of each entity. Then deletes them leaving only the original polyline and points. 2 problems arc's starting point seems to be depended of something other then the polyline direction. And if you select an open polyline the end pt isn't created. Uses thwarts point creation (defun C:Foo (/ SS) (vl-load-com) (princ "\nSelect polylines : ") (setq SS (ssget '((0 . "LWPOLYLINE")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq poly (vlax-invoke (vlax-ename->vla-object e) 'explode)) (foreach ent poly (foreach pt (list (vlax-curve-getStartPoint ent) ;Tharwat (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.00))) (entmake (list '(0 . "POINT") (cons 10 pt))) ) ;end foreach (vla-delete ent) ) ;end foreach ) ;end foreach (princ) )
    1 point
  5. I think this should be enough. < untested >. (defun c:Test ( / sel int ent get inc) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi - 8.Feb.2022 ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect polylines to locate points on end and mid points : ") (setq int -1 sel (ssget '((0 . "LWPOLYLINE")))) (while (setq int (1+ int) ent (ssname sel int)) (setq get (entget ent) inc -1 ) (foreach pt get (and (= (car pt) 10) (setq inc (1+ inc)) (foreach ins (list (vlax-curve-getpointatparam ent inc) (vlax-curve-getpointatparam ent (- inc 0.5)) ) (and ins (entmake (list '(0 . "POINT") (cons 10 ins)))) ) ) ) ) ) (princ) ) (vl-load-com)
    1 point
  6. Try this, It works by drawing temporary plines each 1 element of your selection, and using Tharwats code to plot points at their end and mid points. EDITED... it adds multiple points at the end of each vertex, just need to do a small modification later Apparently Tuesdays I have to work as well as Monday, who knew? Will come back to look at this later (defun c:test ( / endpoint curve midpoints ss acount mycount ent entdesc pt) (vl-load-com) ;;Get verticies, Points: 10 and Curve: 42 (princ "\nSelect polylines : ") (setq ss (ssget '((0 . "LWPOLYLINE")))) (setq acount 0) (while (< acount (sslength ss)) (setq endpoint (list)) (setq curve (list)) (setq ent (ssname ss acount)) (setq entdesc (entget ent)) (foreach x entdesc (if (= (car x) 10) (setq endpoint (append endpoint (list (cdr x)))) ) (if (= (car x) 42) (setq curve (append curve (list (cdr x)))) ) ) ;;Make temporary plines & get mid points (setq mycount 1) (while (< mycount (length endpoint)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 2) (cons 70 0) (cons 10 (nth (- mycount 1) endpoint)) (cons 42 (nth (- mycount 1) curve)) (cons 10 (nth mycount endpoint)) )) ;;end entmake (setq ent (entlast)) (setq get (entget ent)) ;;From Tharwart (foreach pt (list (cdr (assoc 10 get)) (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.0))) (entmake (list '(0 . "POINT") (cons 10 pt))) ) ;end for each (entdel ent) ;;delete temp pline (setq mycount (+ mycount 1)) ) ; end while (entmake (list '(0 . "POINT") (cons 10 (last endpoint)))) (setq acount (+ acount 1)) ) ; end while (princ) )
    1 point
  7. Another way to approach the same goal. (defun c:Test ( / sel int ent get ) ;; Tharwat - 8.Feb.2022 ;; (and (princ "\nSelect polylines to locate points on end points and center : ") (setq int -1 sel (ssget '((0 . "LWPOLYLINE")))) (while (setq int (1+ int) ent (ssname sel int)) (setq get (entget ent)) (foreach pt (list (cdr (assoc 10 get)) (cdr (assoc 10 (reverse get))) (vlax-curve-getpointatdist ent (/ (vlax-curve-getdistatpoint ent (vlax-curve-getendpoint ent)) 2.0))) (entmake (list '(0 . "POINT") (cons 10 pt))) ) ) ) (princ) ) (vl-load-com)
    1 point
  8. Should be what your looking for. (defun C:PP (/ SS vla SPT MPT EPT) (prompt "\nSelect Polylines") (if (setq SS (ssget '((0 . "*POLYLINE")))) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq vla (vlax-ename->vla-object poly) SPT (vlax-curve-getStartPoint vla) MPT (vlax-curve-getPointAtDist vla (/ (vlax-get-property vla 'length) 2.0)) EPT (vlax-curve-getendpoint vla) ) (entmake (list '(0 . "POINT") (cons 10 SPT))) (entmake (list '(0 . "POINT") (cons 10 MPT))) (entmake (list '(0 . "POINT") (cons 10 EPT))) ) ) (princ) )
    1 point
  9. try this lisp. I got it from a friend. cr.lsp
    1 point
×
×
  • Create New...