benhubel Posted May 9, 2016 Posted May 9, 2016 (edited) In Maya, it's called soft select. In Blender it's called proportional editing mode. I am looking for a tool that will let me move a grip, causing all of the nearby vertices to move in the same direction. The amount of movement depends on how close it is to the selected grip as well as how sharp you set your falloff. Some videos to give you an idea of what i'm talking about: Soft Select - Proportional Editing - The general idea is that when the user selects a grip, the LISP would search for all valid vertices in the maximum falloff range. Next, when the user moves (or scales, scale would be cool too) that grip, each affected vertex moves in that direction at a percentage of the distance that the target vertex has moved, depending on how close it is to that target vertex. Bonus points if there is also an option that allows the code to only affect lines that are connected to the target vertex by being part of the same polyline. Additional bonus points if the code is heavily commented so that I can see what's going on. This program is way over my head, and I would really love to learn how it would be done. **EDIT** I don't care if it works in 3d or not. I mostly just work with 2d when using AutoCAD. Edited May 9, 2016 by benhubel Added note Quote
marko_ribar Posted May 10, 2016 Posted May 10, 2016 (edited) Hi... I think I've used intuitive variable names, so I didn't comment the code, but if you don't understand something, just ask... I and maybe someone else will give you correct explanation... (defun c:softselvertmod ( / *error* barycent *adoc* ucsf osm 3dosm ss e ch pl p vl c r v v1 vln eg ex xx p1 p2 rf gr ux uy uc ) (vl-load-com) (defun *error* ( m ) (if ucsf (command "_.UCS" "_P") ) (if osm (setvar 'osmode osm) ) (if 3dosm (setvar '3dosmode 3dosm) ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (defun barycent ( l ) (mapcar '(lambda ( x ) (/ x (length l))) (list (apply '+ (mapcar 'car l)) (apply '+ (mapcar 'cadr l)) (apply '+ (mapcar 'caddr l)))) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (if (= (getvar 'worlducs) 0) (progn (command "_.UCS" "_W") (setq ucsf t) ) ) (setq osm (getvar 'osmode)) (if (getvar '3dosmode) (setq 3dosm (getvar '3dosmode)) ) (prompt "\nPick editable entity for softselvertmod (SPLINE,POLYLINE,MESH,POLYFACE MESH) on unlocked layer...") (setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE,SPLINE,MESH")))) (while (not ss) (prompt "\nMissed - empty sel.set... Please pick editable entity for softselvertmod (SPLINE,POLYLINE,MESH,POLYFACE MESH) on unlocked layer...") (setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE,SPLINE,MESH")))) ) (setq e (ssname ss 0)) (initget "Move-Stretch Twist Scale-Shrink") (setq ch (getkword "\nChoose mode [Move-Stretch/Twist/Scale-Shrink] <Move-Stretch> : ")) (if (null ch) (setq ch "Move-Stretch") ) (cond ( (= ch "Move-Stretch") (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (and (= (cdr (assoc 0 (entget e))) "POLYLINE") (= "AcDb2dPolyline" (cdr (assoc 100 (reverse (entget e)))))) ;;; - it's old heavy 2D POLYLINE (command "_.CONVERTPOLY" "_L" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq eg (entget e)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") (command "_.CONVERTPOLY" "_H" e) (while (< 0 (getvar 'cmdactive)) (command "") ) ) ( (= (cdr (assoc 0 (entget e))) "POLYLINE") ;;; it's 3DPOLYLINE or POLYFACE MESH (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq pl (cons (cdr (assoc 10 (entget v))) pl)) ) (setq pl (reverse pl)) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (if (setq xx (vl-member-if '(lambda ( p ) (equal p (cdr (assoc 10 (entget v))) 1e-6)) vl)) (entupd (cdr (assoc -1 (entmod (subst (cons 10 (nth (vl-position (car xx) vl) vln)) (assoc 10 (entget v)) (entget v)))))) ) ) (entupd e) (setq vl vln) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (= (cdr (assoc 0 (entget e))) "MESH") ;;; it's MESH (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq eg (entget e)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( t ;;; else - it's SPLINE (if (assoc 11 (entget e)) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 11)) (entget e)))) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 16) (setvar 'osmode 0) ) (setvar 'osmode 1) ) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 0) (setvar 'osmode 0) ) (setvar 'osmode 0) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq eg (entget e)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ) ) ( (= ch "Twist") (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq c (mapcar '+ c (mapcar '* (mapcar '- c (barycent vl)) (list 0.5 0.5 0.5)))) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (+ (angle (trans p1 0 e) (trans p 0 e)) (* (if (equal (distance c p) 0.0 1e-6) (/ (distance '(0.0 0.0 0.0) v) 0.1) (/ (distance '(0.0 0.0 0.0) v) (distance c p))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (and (= (cdr (assoc 0 (entget e))) "POLYLINE") (= "AcDb2dPolyline" (cdr (assoc 100 (reverse (entget e)))))) ;;; - it's old heavy 2D POLYLINE (command "_.CONVERTPOLY" "_L" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq c (mapcar '+ c (mapcar '* (mapcar '- c (barycent vl)) (list 0.5 0.5 0.5)))) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (+ (angle (trans p1 0 e) (trans p 0 e)) (* (if (equal (distance c p) 0.0 1e-6) (/ (distance '(0.0 0.0 0.0) v) 0.1) (/ (distance '(0.0 0.0 0.0) v) (distance c p))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") (command "_.CONVERTPOLY" "_H" e) (while (< 0 (getvar 'cmdactive)) (command "") ) ) ( (= (cdr (assoc 0 (entget e))) "POLYLINE") ;;; it's 3DPOLYLINE or POLYFACE MESH (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq pl (cons (cdr (assoc 10 (entget v))) pl)) ) (setq pl (reverse pl)) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq c (mapcar '+ c (mapcar '* (mapcar '- c (barycent vl)) (list 0.5 0.5 0.5)))) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (+ (angle (trans p1 0 v) (trans p 0 v)) (* (if (equal (distance c p) 0.0 1e-6) (/ (distance '(0.0 0.0 0.0) v) 0.1) (/ (distance '(0.0 0.0 0.0) v) (distance c p))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (if (setq xx (vl-member-if '(lambda ( p ) (equal p (cdr (assoc 10 (entget v))) 1e-6)) vl)) (entupd (cdr (assoc -1 (entmod (subst (cons 10 (nth (vl-position (car xx) vl) vln)) (assoc 10 (entget v)) (entget v)))))) ) ) (entupd e) (setq vl vln) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (= (cdr (assoc 0 (entget e))) "MESH") ;;; it's MESH (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq c (mapcar '+ c (mapcar '* (mapcar '- c (barycent vl)) (list 0.5 0.5 0.5)))) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (+ (angle (trans p1 0 v) (trans p 0 v)) (* (if (equal (distance c p) 0.0 1e-6) (/ (distance '(0.0 0.0 0.0) v) 0.1) (/ (distance '(0.0 0.0 0.0) v) (distance c p))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( t ;;; else - it's SPLINE (if (assoc 11 (entget e)) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 11)) (entget e)))) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 16) (setvar 'osmode 0) ) (setvar 'osmode 1) ) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 0) (setvar 'osmode 0) ) (setvar 'osmode 0) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq c (mapcar '+ c (mapcar '* (mapcar '- c (barycent vl)) (list 0.5 0.5 0.5)))) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (+ (angle (trans p1 0 v) (trans p 0 v)) (* (if (equal (distance c p) 0.0 1e-6) (/ (distance '(0.0 0.0 0.0) v) 0.1) (/ (distance '(0.0 0.0 0.0) v) (distance c p))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ) ) ( (= ch "Scale-Shrink") (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (angle (trans p1 0 e) (trans p 0 e)) (if (equal (distance c p) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance c p))))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (and (= (cdr (assoc 0 (entget e))) "POLYLINE") (= "AcDb2dPolyline" (cdr (assoc 100 (reverse (entget e)))))) ;;; - it's old heavy 2D POLYLINE (command "_.CONVERTPOLY" "_L" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (angle (trans p1 0 e) (trans p 0 e)) (if (equal (distance c p) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance c p))))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") (command "_.CONVERTPOLY" "_H" e) (while (< 0 (getvar 'cmdactive)) (command "") ) ) ( (= (cdr (assoc 0 (entget e))) "POLYLINE") ;;; it's 3DPOLYLINE or POLYFACE MESH (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq pl (cons (cdr (assoc 10 (entget v))) pl)) ) (setq pl (reverse pl)) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (angle (trans p1 0 v) (trans p 0 v)) (if (equal (distance c p) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance c p))))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (if (setq xx (vl-member-if '(lambda ( p ) (equal p (cdr (assoc 10 (entget v))) 1e-6)) vl)) (entupd (cdr (assoc -1 (entmod (subst (cons 10 (nth (vl-position (car xx) vl) vln)) (assoc 10 (entget v)) (entget v)))))) ) ) (entupd e) (setq vl vln) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (= (cdr (assoc 0 (entget e))) "MESH") ;;; it's MESH (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setvar 'osmode 0) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (angle (trans p1 0 v) (trans p 0 v)) (if (equal (distance c p) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance c p))))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( t ;;; else - it's SPLINE (if (assoc 11 (entget e)) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 11)) (entget e)))) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 16) (setvar 'osmode 0) ) (setvar 'osmode 1) ) (while (setq p (getpoint "\nPick or specify main vertex-vertices for softselvertmod - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 0) (setvar 'osmode 0) ) (setvar 'osmode 0) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of softselvertmod : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of softselvertmod : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (angle (trans p1 0 v) (trans p 0 v)) (if (equal (distance c p) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance c p))))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ) ) ) (*error* nil) ) HTH, M.R. Edited May 12, 2016 by marko_ribar code finally changed - no more changes... Quote
benhubel Posted May 10, 2016 Author Posted May 10, 2016 Ah, yes! Although it's a bit clunky, it definitely has everything that I needed to get started. Thank you. I'll be looking into ways I can streamline the interface, as well as allowing the user to change the falloff. I'll mostly aim to use a bell curve of sorts. Quote
marko_ribar Posted May 10, 2016 Posted May 10, 2016 I've updated it to include Twist option... M.R. Quote
marko_ribar Posted May 11, 2016 Posted May 11, 2016 I've updated it to include Scale-Shrink option... Also added (grread-while loop) to be visually more acceptable... M.R. Quote
marko_ribar Posted May 11, 2016 Posted May 11, 2016 The code was updated once more, but it isn't as good as what I was expecting... Quote
benhubel Posted May 11, 2016 Author Posted May 11, 2016 The live adjust makes this massively more useful. It also helps me to see how it's working so that I can edit it more easily. I'm a bit confused about the twist option though. It seems to be acting weird. Quote
marko_ribar Posted May 11, 2016 Posted May 11, 2016 I'm a bit confused about the twist option though. It seems to be acting weird. It's because I've tried and did succeed to replicate vulcano tutorial from your posted video clip examples... The point is that top most faces should rotate (twist) the most, while near bottom the least - so I've included that in formula for (setq vln ...)... But you're right - in most cases like my newest tests this is weird, but what the .... . M.R. Quote
benhubel Posted May 11, 2016 Author Posted May 11, 2016 (edited) I have modified the code slightly to make a faster workflow and to be easier to work with. It no longer asks for the first point of the vector, now utilizing the same point that the circle radius uses. Is there a reasonable way to change the direction of the vector dynamically based on the cursor position the way that the scale does? It appears to me as if it the vector direction changes the UCS, and I'm not sure if it's ok to constantly update the UCS like that. **edit** It seems I'm having mild difficulty getting the scale feature to work with changing the first vector point to the scale circle center. (defun c:sse () (c:SoftSelectEdit)) ;shortcut to call SoftSelectEdit (defun c:SoftSelectEdit ( / *error* barycent *adoc* ucsf osm 3dosm ss e ch pl p vl c r v v1 vln eg ex xx p1 p2 rf gr ux uy uc ) (vl-load-com) (defun *error* ( m ) (if ucsf (command "_.UCS" "_P") ) (if osm (setvar 'osmode osm) ) (if 3dosm (setvar '3dosmode 3dosm) ) (vla-endundomark *adoc*) (if m (prompt m) ) (princ) ) (defun barycent ( l ) (mapcar '(lambda ( x ) (/ x (length l))) (list (apply '+ (mapcar 'car l)) (apply '+ (mapcar 'cadr l)) (apply '+ (mapcar 'caddr l)))) ) (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))) (if (= (getvar 'worlducs) 0) (progn (command "_.UCS" "_W") (setq ucsf t) ) ) (setq osm (getvar 'osmode)) (if (getvar '3dosmode) (setq 3dosm (getvar '3dosmode)) ) (prompt "\nPick editable entity for SoftSelectEdit (SPLINE,POLYLINE,MESH,POLYFACE MESH) on unlocked layer...") (setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE,SPLINE,MESH")))) (while (not ss) (prompt "\nMissed - empty sel.set... Please pick editable entity for SoftSelectEdit (SPLINE,POLYLINE,MESH,POLYFACE MESH) on unlocked layer...") (setq ss (ssget "_+.:E:S:L" '((0 . "*POLYLINE,SPLINE,MESH")))) ) (setq e (ssname ss 0)) (initget "Move-Stretch Twist Scale-Shrink") (setq ch (getkword "\nChoose mode [Move-Stretch/Twist/Scale-Shrink] <Move-Stretch> : ")) (if (null ch) (setq ch "Move-Stretch") ) (cond ( (= ch "Move-Stretch") (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (trans c 0 1)) ;use the circle center point as the vector start point (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (and (= (cdr (assoc 0 (entget e))) "POLYLINE") (= "AcDb2dPolyline" (cdr (assoc 100 (reverse (entget e)))))) ;;; - it's old heavy 2D POLYLINE (command "_.CONVERTPOLY" "_L" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of softselvertmod : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq eg (entget e)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") (command "_.CONVERTPOLY" "_H" e) (while (< 0 (getvar 'cmdactive)) (command "") ) ) ( (= (cdr (assoc 0 (entget e))) "POLYLINE") ;;; it's 3DPOLYLINE or POLYFACE MESH (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq pl (cons (cdr (assoc 10 (entget v))) pl)) ) (setq pl (reverse pl)) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (if (setq xx (vl-member-if '(lambda ( p ) (equal p (cdr (assoc 10 (entget v))) 1e-6)) vl)) (entupd (cdr (assoc -1 (entmod (subst (cons 10 (nth (vl-position (car xx) vl) vln)) (assoc 10 (entget v)) (entget v)))))) ) ) (entupd e) (setq vl vln) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (= (cdr (assoc 0 (entget e))) "MESH") ;;; it's MESH (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq eg (entget e)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( t ;;; else - it's SPLINE (if (assoc 11 (entget e)) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 11)) (entget e)))) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 16) (setvar 'osmode 0) ) (setvar 'osmode 1) ) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (setq eg (entget e)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (mapcar '+ p (mapcar '* v (list (/ (- r (distance c p)) r) (/ (- r (distance c p)) r) (/ (- r (distance c p)) r))))) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ) ) ( (= ch "Twist") (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (+ (angle (trans p1 0 e) (trans p 0 e)) (* (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (and (= (cdr (assoc 0 (entget e))) "POLYLINE") (= "AcDb2dPolyline" (cdr (assoc 100 (reverse (entget e)))))) ;;; - it's old heavy 2D POLYLINE (command "_.CONVERTPOLY" "_L" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (+ (angle (trans p1 0 e) (trans p 0 e)) (* (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") (command "_.CONVERTPOLY" "_H" e) (while (< 0 (getvar 'cmdactive)) (command "") ) ) ( (= (cdr (assoc 0 (entget e))) "POLYLINE") ;;; it's 3DPOLYLINE or POLYFACE MESH (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq pl (cons (cdr (assoc 10 (entget v))) pl)) ) (setq pl (reverse pl)) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (+ (angle (trans p1 0 v) (trans p 0 v)) (* (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (if (setq xx (vl-member-if '(lambda ( p ) (equal p (cdr (assoc 10 (entget v))) 1e-6)) vl)) (entupd (cdr (assoc -1 (entmod (subst (cons 10 (nth (vl-position (car xx) vl) vln)) (assoc 10 (entget v)) (entget v)))))) ) ) (entupd e) (setq vl vln) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (= (cdr (assoc 0 (entget e))) "MESH") ;;; it's MESH (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (+ (angle (trans p1 0 v) (trans p 0 v)) (* (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( t ;;; else - it's SPLINE (if (assoc 11 (entget e)) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 11)) (entget e)))) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 16) (setvar 'osmode 0) ) (setvar 'osmode 1) ) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (initget 2) (setq rf (getreal "\nSpecify rotation factor per vector intensity in decimal degrees <10.0> : ")) (if (null rf) (setq rf 10.0) ) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (+ (angle (trans p1 0 v) (trans p 0 v)) (* (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (cvunit rf "degree" "radian"))) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ) ) ( (= ch "Scale-Shrink") (cond ( (= (cdr (assoc 0 (entget e))) "LWPOLYLINE") (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (angle (trans p1 0 e) (trans p 0 e)) (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (and (= (cdr (assoc 0 (entget e))) "POLYLINE") (= "AcDb2dPolyline" (cdr (assoc 100 (reverse (entget e)))))) ;;; - it's old heavy 2D POLYLINE (command "_.CONVERTPOLY" "_L" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget e)))) e 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e))))) (command "_.UCS" "_E" e) (while (< 0 (getvar 'cmdactive)) (command "") ) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons (trans p 1 0) vl)) (print (trans p 1 0)) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.CIRCLE" "_non" (trans c 0 1) "\\") (setq r (cdr (assoc 40 (entget (entlast))))) (entdel (entlast)) (setq p1 (getpoint (trans c 0 1) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (trans p2 1 0) (trans p1 1 0))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_3P" "_non" p1 "_non" p2 "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 e) (angle (trans p1 0 e) (trans p 0 e)) (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 e)) (trans p 0 e)))))) (list (caddr (trans p 0 e)))) e 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) (mapcar '+ '(0.0 0.0) (trans y 0 e)) 1e-6)) vl)) (cons 10 (mapcar '+ '(0.0 0.0) (trans (nth (vl-position (car xx) vl) vln) 0 e))) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") (command "_.CONVERTPOLY" "_H" e) (while (< 0 (getvar 'cmdactive)) (command "") ) ) ( (= (cdr (assoc 0 (entget e))) "POLYLINE") ;;; it's 3DPOLYLINE or POLYFACE MESH (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (setq pl (cons (cdr (assoc 10 (entget v))) pl)) ) (setq pl (reverse pl)) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (angle (trans p1 0 v) (trans p 0 v)) (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq v e) (while (= (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX") (if (setq xx (vl-member-if '(lambda ( p ) (equal p (cdr (assoc 10 (entget v))) 1e-6)) vl)) (entupd (cdr (assoc -1 (entmod (subst (cons 10 (nth (vl-position (car xx) vl) vln)) (assoc 10 (entget v)) (entget v)))))) ) ) (entupd e) (setq vl vln) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( (= (cdr (assoc 0 (entget e))) "MESH") ;;; it's MESH (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) (setvar 'osmode 1) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (angle (trans p1 0 v) (trans p 0 v)) (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ( t ;;; else - it's SPLINE (if (assoc 11 (entget e)) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 11)) (entget e)))) (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget e)))) ) (if (getvar '3dosmode) (progn (setvar '3dosmode 16) (setvar 'osmode 0) ) (setvar 'osmode 1) ) (while (setq p (getpoint "\nPick or specify main vertex-vertices for SoftSelectEdit - ENTER TO FINISH : ")) (setq vl (cons p vl)) (print p) ) (setq c (barycent vl)) (prompt "\nPick or specify radius of SoftSelectEdit : ") (command "_.SPHERE" "_non" c "\\") (setq r (expt (/ (* 3.0 (vla-get-volume (vlax-ename->vla-object (entlast)))) 4.0 pi) (/ 1.0 3.0))) (entdel (entlast)) (initget 1 "XY YZ ZX") (setq uc (getkword "\nChoose option of setting UCS [XY/YZ/ZX] : ")) (cond ( (= uc "XY") (setq ux (mapcar '+ c '(1.0 0.0 0.0))) (setq uy (mapcar '+ c '(0.0 1.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "YZ") (setq ux (mapcar '+ c '(0.0 1.0 0.0))) (setq uy (mapcar '+ c '(0.0 0.0 1.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ( (= uc "ZX") (setq ux (mapcar '+ c '(0.0 0.0 1.0))) (setq uy (mapcar '+ c '(1.0 0.0 0.0))) (command "_.UCs" "_3P" "_non" c "_non" ux "_non" uy) ) ) (setq p1 (getpoint '(0.0 0.0 0.0) "\nPick or specify start point of vector of SoftSelectEdit : ")) (setq p2 (getpoint p1 "\nPick or specify end point of vector of SoftSelectEdit : ")) (setq v (mapcar '- (setq p2 (trans p2 1 0)) (setq p1 (trans p1 1 0)))) (setq v1 (mapcar '/ v (list (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v) (distance '(0.0 0.0 0.0) v)))) (setq vl (vl-remove-if-not '(lambda ( x ) (< (distance c x) r)) pl)) (command "_.UCS" "_ZA" "_non" (trans p1 0 1) "_non" (trans p2 0 1) "") (setq eg (entget e)) (while (= 5 (car (setq gr (grread t)))) (setq v (mapcar '* v1 (list (car (cadr gr)) (car (cadr gr)) (car (cadr gr))))) (setq vln (mapcar '(lambda ( p ) (trans (append (mapcar '+ '(0.0 0.0) (polar (trans p1 0 v) (angle (trans p1 0 v) (trans p 0 v)) (if (equal (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)) 0.0 1e-6) 0.0 (/ (distance '(0.0 0.0 0.0) v) (distance (mapcar '+ '(0.0 0.0) (trans p1 0 v)) (trans p 0 v)))))) (list (caddr (trans p 0 v)))) v 0)) vl)) (setq ex (mapcar '(lambda ( x / xx ) (if (setq xx (vl-member-if '(lambda ( y ) (equal (cdr x) y 1e-6)) vl)) (cons (car x) (nth (vl-position (car xx) vl) vln)) x)) eg)) (entupd (cdr (assoc -1 (entmod ex)))) ) (command "_.UCS" "_P") (command "_.UCS" "_P") ) ) ) ) (*error* nil) ) Edited May 11, 2016 by benhubel Updated Code Slightly Quote
benhubel Posted May 11, 2016 Author Posted May 11, 2016 Also, I'm not sure if the ability to select multiple main vertices is working right or not. It seems to work quite well with just one. I'd probably be inclined to drop that multiple vert functionality altogether, unless you think it can be done more smoothly. Quote
marko_ribar Posted May 11, 2016 Posted May 11, 2016 Look I've updated it again in my first post... Should be much better with twist and scale options... I've kept all previous settings... If you're not familiar, when asked for first point of vector, just type "@" that means already picked point by (getpoint) and then specify end point along vector of normal for that action (twist - predominantly)... M.R. Quote
benhubel Posted May 11, 2016 Author Posted May 11, 2016 It seems that the way it adjusts the curves is a bit... clunky. I haven't yet figured out what types of calculations will be needed to adjust them smoothly though. Quote
benhubel Posted May 11, 2016 Author Posted May 11, 2016 Look I've updated it again in my first post... Should be much better with twist and scale options... I've kept all previous settings... If you're not familiar, when asked for first point of vector, just type "@" that means already picked point by (getpoint) and then specify end point along vector of normal for that action (twist - predominantly)... M.R. I'm really glad to know the "@" command. Thanks. It seems that with the scale and twist options (older and newer code variations), they sometimes jump into the middle of nowhere, typically somewhere near the origin, but I haven't noticed any consistencies. I'll keep testing to figure out why. It doesn't seem to happen at all on the move option. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.