Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/15/2020 in all areas

  1. You can use "member" in place of vl-position. It's just that "vl-position" is just slightly faster than "member". It accepts exactly the same arguments as "vl-position". As for vl-remove-if-not, I don't think there's another. You just have to make one: (defun vl-remove-if-not2 (fnc lst / rtn) (foreach x lst (if ((eval fnc) x) (setq rtn (cons x rtn)) ) ) (reverse rtn) )
    1 point
  2. Just copy it using vla-Copy and then move it using vla-Move (although this uses VLisp) ;; ent - entity object ;; pt1 - base point ;; pt2 - move point (defun pl (ent pt1 pt2) (vla-Move (vla-Copy (vlax-ename->vla-object ent)) (vlax-3d-point pt1) (vlax-3d-point pt2)) ) If you want just the coordinates: (mapcar 'cdr (vl-remove-if-not '(lambda (x) (vl-position (car x) '(10 11))) (entget pl)))
    1 point
  3. Hello, try this if you want (setq sset (ssget '((0 . "LWPOLYLINE")))) ;;;;;;;;;;;;;;;; ;repeat for n selected plines (repeat (setq i (sslength sset)) (setq nam (ssname sset (setq i (1- i)))) (setq ent (entget nam)) (setq entD ent) (setq tt (assoc 10 entD)) ;;;;; ;Create list from X Y (while (/= nil tt) (setq all (cons tt all)) (setq entD (vl-remove tt entD)) (setq tt (assoc 10 entD)) ); end while ) (setq all (reverse all)) Hope to help you if dont work i will modify it.
    1 point
  4. You're right, I opened Pandora's box and now I can't handle it, sorry for that.
    1 point
  5. Another one (defun disspacify (str / regexp) (if (setq regexp (vlax-get-or-create-object "vbscript.regexp")) (progn (vlax-put-property regexp 'global actrue) (vlax-put-property regexp 'pattern " +") (vlax-invoke regexp 'replace (vl-string-trim " " str) " ") ) ) ) _$ (disspacify " This is a normal string. ") "This is a normal string." _$ [Edit]: Why not full regular expression... Plus, the dot or comma inside the string needs special treatment: (defun disspacify (str / regexp) (if (setq regexp (vlax-get-or-create-object "vbscript.regexp")) (progn (vlax-put-property regexp 'global actrue) (foreach x '( (" +[.]|[.]" . ". ");"end ." to "end. " (" +[,]|[,]" . ", ");"mid ," to "mid, " (" +" . " ");replace multiple spaces ("^ +| +$" . "");remove start and end space(s) ) (vlax-put-property regexp 'pattern (car x)) (setq str (vlax-invoke regexp 'replace str (cdr x))) ) ) ) ) _$ (disspacify " This is a double sentence ,the other one is not .This is a normal string . ") "This is a double sentence, the other one is not. This is a normal string." _$
    1 point
  6. @motee-z Here's a revised version that adds text to the face with the slope value. It also checks that the firsts 3 vertices of the face are not duplicates. It does not check to see if they are collinear. ;; Determine the maximum slope of a 3dface. ;; 7/13/2020 (defun c:FaceSlope (/ ss en edata p1 p2 p3 v1 sv a slope midpt s endpt) (setq oldsnap (getvar "osmode")) (setvar "osmode" 0) (princ "\nPlease select 3DFACE and press ENTER.") (setq ss (ssget) en (ssname ss 0) edata (entget en) ) (setvar "cmdecho" 0) (if (= (cdr (assoc 0 edata)) "3DFACE") (progn (setq p1 (cdr (assoc 10 edata)) ;set p1, p2, p3 to the three vertices of the 3DFACE p2 (cdr (assoc 11 edata)) p3 (cdr (assoc 12 edata)) ) (if (or (equal p1 p2 0.0001) (equal p1 p3 0.0001) (equal p3 p2 0.0001) ) (princ "\nThe first 3 vertices of the face are not unique.") (progn (setq normal (cross (mapcar '- p2 p1) (mapcar '- p3 p1))) (setq v1 (cross '(0.0 0.0 1.0) normal)) (setq sv (cross v1 normal)) (setq a (distance '(0 0 0) sv)) (setq sv (mapcar '/ sv (list a a a))) (setq a (expt (+ (expt (car sv) 2) (expt (cadr sv) 2)) 0.5)) ;; check if a = 0 (if (< (abs a) 0.00001) (setq slope "Vertical") (setq slope (/ (caddr sv) a)) ) (princ "\nThe slope is: ") (princ slope) (princ "\nThe slope vector is: ") (princ sv) (setq midpt (mapcar '/ (mapcar '+ p1 p2 p3) '(3.0 3.0 3.0))) (setq s (/ (+ (distance p1 p2) (distance p2 p3) (distance p1 p3)) 3.0) ) (setq endpt (mapcar '+ midpt (mapcar '* sv (list s s s)))) (command "_line" midpt endpt "") ;; draw line showing maximum slope (setq slope (LM:roundto slope 3)) (command "text" midpt "" "" slope "") ) ; end if false, no duplicates ) ;end true, is face ) ; end if duplicate (princ "\nSelected object must be a face.") ) ; end if face (setvar "osmode" oldsnap) (setvar "cmdecho" 1) (princ) ) ;;; Compute the cross product of 2 vectors a and b (defun cross (a b / crs) (setq crs (list (- (* (nth 1 a) (nth 2 b)) (* (nth 1 b) (nth 2 a)) ) (- (* (nth 0 b) (nth 2 a)) (* (nth 0 a) (nth 2 b)) ) (- (* (nth 0 a) (nth 1 b)) (* (nth 0 b) (nth 1 a)) ) ) ;end list ) ;end setq c ) ;end cross ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Round Multiple - Lee Mac ;; Rounds 'n' to the nearest multiple of 'm' (defun LM:roundm (n m) (* m (atoi (rtos (/ n (float m)) 2 0))) ) ;; Round To - Lee Mac ;; Rounds 'n' to 'p' decimal places (defun LM:roundto (n p) (LM:roundm n (expt 10.0 (- p))) )
    1 point
  7. If you want half the vertices can just get the all vertice XYZ save start and end then skip every second one, put back the new vertices. VlA-PUT big hint. Look at co-ordsxy. ; pline co-ords example (defun getcoords (ent) (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object ent) "Coordinates" ) ) ) ) ; convert now to xyz (defun co-ords2xy () (if (= xyz 2) (progn (setq I 0) (repeat numb (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 2)) ) ) ) ) (defun getlength (ent) (vlax-get-property (vlax-ename->vla-object ent) "Length" ) ) (if (= xyz 3) (progn (setq I 0) (repeat numb (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) )) (setq co-ordsxy (cons xy co-ordsxy)) (setq I (+ I 3)) ) ) ) ; program starts here 3 for a 3d polyline (if (= xyz nil)(SETQ XYZ 3)) (setq co-ords (getcoords (car (entsel "\nPlease pick pline")))) (co-ords2xy) (princ xy) (princ)
    1 point
×
×
  • Create New...