0 Members and 1 Guest are viewing this topic.
(defun C:P3P (/ base en ent perp pt sset) (if (setq ent (entsel "\nSelect curve >>")) (progn (setq en (car ent)) (princ "\n >> Select points") (setq sset (ssget (list (cons 0 "POINT")))) (while (setq pt (ssname sset 0)) (setq base (cdr (assoc 10 (entget pt)))) (setq perp (vlax-curve-getclosestpointto en base)) (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 67 (if (= 0 (getvar "tilemode")) 1 0)) (cons 410 (getvar "ctab")) '(8 . "perp") '(100 . "AcDbLine") (cons 10 base) (cons 11 perp) )) (ssdel pt sset) ) ) ) (princ) )(princ "\n\t\t***\tStart command with P3P ...\t***")(prin1)(vl-load-com)
Hello everybody,after drawing perpendicular lines from points to a 3dpoly, I have to measure the distance between consecutive intersection 3dpoly - perpendicular line. A lisp to do this will help me a lot... See the attachment - drawing. Thanks!
(defun C:P3P (/ base en ent perp pt pt_list sset txthgt txtpt) (if (setq ent (entsel "\nSelect curve >>")) (progn (setq en (car ent)) (princ "\n >> Select points") (setq sset (ssget (list (cons 0 "POINT")))) (while (setq pt (ssname sset 0)) (setq base (cdr (assoc 10 (entget pt)))) (setq perp (vlax-curve-getclosestpointto en base)) (setq pt_list (cons perp pt_list)) (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 67 (if (= 0 (getvar "tilemode")) 1 0)) (cons 410 (getvar "ctab")) '(8 . "perp");<-- layer for lines '(100 . "AcDbLine") (cons 10 base) (cons 11 perp) )) (ssdel pt sset) ) (setq pt_list (reverse pt_list)) (setq pt_list (vl-sort pt_list (function (lambda (a b) (< (vlax-curve-getdistatpoint en a) (vlax-curve-getdistatpoint en b)))) ) ) (setq txthgt 0.6);<-- text height (while (cadr pt_list) (setq txtpt (vlax-curve-getclosestpointto en (mapcar (function (lambda (p q) (/ (+ p q) 2))) (car pt_list)(cadr pt_list))) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") (cons 67 (if (= 0 (getvar "tilemode")) 1 0)) (cons 410 (getvar "ctab")) '(8 . "points");<-- layer for texts '(100 . "AcDbText") (cons 10 txtpt) (cons 11 (list (car txtpt) (+ (cadr txtpt) txthgt) 0.0)) (cons 40 txthgt) (cons 1 (rtos (distance (car pt_list)(cadr pt_list)) 2 2)) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) '(7 . "Standard");<-- text style '(71 . 0) '(72 . 0) '(73 . 2))) (setq pt_list (cdr pt_list)) ) ) ) (princ) )(princ "\n\t\tStart command with P3P ...\t\t")(prin1)
Try this one(Layer "perp" must be exist)
Quote from: fixo on November 30, 2009, 10:29:37 AMTry this one(Layer "perp" must be exist)I believe entmake will create any non-existent layers
(defun c:test nil (entmake '((0 . "LINE") (8 . "LeeMac") (10 . (0 0 0)) (11 . (1 0 0)))) (princ))
(entmake (list (cons 0 "LINE") (cons 10 (list 0.0 0.0 0.0)) (cons 11 (list 0.0 1.0 0.0)) ))
Try it:Code: [Select](defun c:test nil (entmake '((0 . "LINE") (8 . "LeeMac") (10 . (0 0 0)) (11 . (1 0 0)))) (princ))
fixoHere is the thing, this is all that is needed to make a line.Code: [Select](entmake (list (cons 0 "LINE") (cons 10 (list 0.0 0.0 0.0)) (cons 11 (list 0.0 1.0 0.0)) ))Every dxf code missing will be added by ACAD using the current settings for that dxf code.Therefore you do not need dxf 67 41 or 100.Unless you want to force something that is not current.
Fixo, in your post you stress that the layer must exist before running the program. I was showing you that the layer needn't exist, as entmake would create it.
fixo,you code works fine.
Quote from: Lee Mac on November 30, 2009, 02:32:37 PMFixo, in your post you stress that the layer must exist before running the program. I was showing you that the layer needn't exist, as entmake would create it.Sorry, but you realy got meWhere you can see in your code all the layer properties -color, lineweight etc etc etc - that I meanTake it easy~'J'~