Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/11/2019 in all areas

  1. Hi all,i have a lisp which can get the piling as built deviation but need to click one by one. 1.Click the proposed position 2.Click the as built pile position 3.Place the deviation (This is what i do so far) I wonder any lisp which can get the piling as built deviation automatic ?because i alway need to click the piling point (as built) for not less than 600 pile:( attach here with example drawing which i have done Hope my question not sound crazy:oops: or i expect too much which lisp can do. Example piling as built.dwg
    1 point
  2. It worked sir, thank you very much for your effort.
    1 point
  3. Another one for fun (defun c:foo (/ _dxf _sl a b c e p s x) ;; RJP » 2019-01-10 (defun _sl (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))) (defun _dxf (c e) (cdr (assoc c (entget e)))) (cond ((setq s (_sl (ssget))) (foreach x s (if (wcmatch (_dxf 0 x) "CIRCLE,INSERT,POINT") (setq b (cons (_dxf 10 x) b)) (and (= 'real (type (vl-catch-all-apply 'vlax-curve-getendparam (list x)))) (setq a (cons x a)) ) ) ) (and a b (foreach p b (setq c (mapcar '(lambda (x) (list (setq c (vlax-curve-getclosestpointto x p)) (distance p c) (_dxf 8 x)) ) a ) ) (setq c (car (vl-sort c '(lambda (r j) (< (cadr r) (cadr j)))))) (if (not (equal 0 (cadr c) 1e-3)) (progn (setq e (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (car c)) (cons 8 (caddr c)))) ) ;; This line below creates the right example comment out to get left (setq a (cons e a)) ) ) ) ) ) ) (princ) )
    1 point
  4. Here's another - (defun c:ppl ( / ent idx pnt sel ) (if (and (setq sel (LM:ssget "\nSelect points: " '(((0 . "POINT"))))) (progn (while (progn (setvar 'errno 0) (setq ent (entsel "\nSelect curve: ")) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto ent)) (princ "\nInvalid object selected.") ) ) ) ) (setq ent (car ent)) ) ) (repeat (setq idx (sslength sel)) (setq idx (1- idx) pnt (assoc 10 (entget (ssname sel idx))) ) (entmake (list '(0 . "LINE") pnt (cons 11 (vlax-curve-getclosestpointto ent (cdr pnt))))) ) ) (princ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) (vl-load-com) (princ)
    1 point
×
×
  • Create New...