Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 03/23/2020 in all areas

  1. hosneyalaa asks for example code in 1st post ? Some ideas 4 text strings depending on quad use strcat lengths then write a simple mtext 4 lines. I need some time. Something wrong where angles are exact like 0.0 not sure what I have done wrong. (defun c:nsew ( / t1 t2 t3 t4 ss plent co-ord x pt1 pt2) (setq t1 "Northing ") (setq t2 "Easting ") (setq t3 "Southing ") (setq t4 "Westing ") (setq ss (ssget "+.:E:S" '((0 . "LWPOLYLINE")))) (setq plent (ssname ss 0)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))) (setq co-ord (cons (nth (- (length co-ord) 1) co-ord)co-ord)) (setq x 0) (setq pt1 (nth x co-ord)) (repeat (- (length co-ord) 1) (setq pt2 (nth (setq x (+ x 1)) co-ord)) (setq ang (angle pt1 pt2)) (setq dist (strcat (rtos (distance pt1 pt2) 2 3) " ")) (cond ((equal ang 0.0 1e-05 )(setq t1 (strcat t1 dist " " (rtos ang 2 3)))) ((and (>= ang 0.00000001 )(<= ang (/ pi 2.0)))(setq t1 (strcat t1 dist " " (rtos ang 2 3)))) ((and (> ang (+ (/ pi 2.0) 0.00000001))(<= ang pi))(setq t2 (strcat t2 dist " " (rtos ang 2 3)))) ((and (> ang (+ pi 0.00000001))(<= ang (* 1.5 pi)))(setq t3 (strcat t3 dist " " (rtos ang 2 3)))) ((and (> ang (+ (* 1.5 pi) 0.00000001))(<= ang (* 2.0 pi)))(setq t4 (strcat t4 dist " " (rtos ang 2 3)))) ((alert (strcat "missed " (rtos ang 2 6)))) ) (setq pt1 pt2) ) (setq pt1 (getpoint "\nPick Top left for text")) (setq pt2 (getpoint pt1 "\nPick Bottom right")) (command "mtext" pt1 pt2 t1 t2 t3 t4 "") (princ) ) (c:nsew)
    1 point
  2. @hosneyalaa are you after a solution or just ideas?
    1 point
  3. I think this explains here in AUS its 0-360 https://readcivil.com/bearing-in-surveying-definition-types-and-designation-of-bearing/ look at quadrant.
    1 point
  4. Try removing "X" from the SSGET (ssget '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (0 . "attdef") (0 . "dimension") (0 . "leader") (0 . "multileader") (-4 . "OR>"))))
    1 point
  5. OK, I've altered this slightly and tested (as previously). Are you sure these are xref dwgs and not underlays of some kind? To run type detx detachx.lsp
    1 point
  6. You could try this oldie (defun c:detachx ( / *error* c_doc c_blks b_str ss cnt obj) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );_end_*error*_defun (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_blks (vla-get-blocks c_doc) );end_setq (vlax-for blk c_blks (if (= :vlax-true (vlax-get-property blk 'isxref)) (setq b_str (strcat b_str "," vlax-get-property blk 'name))) );end_for (setq b_str (vl-string-trim "," b_str) ss (ssget "_X" (list '(0 . "INSERT") '(410 . "Model") (cons 2 b_str))) );end_setq (cond (ss (repeat (setq cnt (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (vla-detach obj) );end_repeat ) );end_cond (princ) );end_defun There are no checks for locked layers, so ensure all relevant layers are unlocked. I would also test it on a copy of a drawing first.
    1 point
  7. You can actually achieve this with a self-referencing text field (though, this has to be created programmatically): (defun c:test ( / o p ) (if (setq p (getpoint "\nSpecify insertion point: ")) (progn (setq o (vla-addtext (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace ) ) " " (vlax-3D-point (trans p 1 0)) (getvar 'textsize) ) ) (vla-put-textstring o (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid o) ">%).InsertionPoint \\f \"%lu2%pt3%pr1\">%" ) ) (vla-regen (LM:acdoc) acactiveviewport) ) ) (princ) ) ;; ObjectID - Lee Mac ;; Returns a string containing the ObjectID of a supplied VLA-Object ;; Compatible with 32-bit & 64-bit systems (defun LM:objectid ( obj ) (eval (list 'defun 'LM:objectid '( obj ) (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring) (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false) '(itoa (vla-get-objectid obj)) ) ) ) (LM:objectid obj) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) (vl-load-com) (princ)
    1 point
  8. I have a small request/idea about the posted codes: include a "select all button" so one doesn't have to scroll through all the lines.
    1 point
  9. No need to apologise, you're welcome.
    1 point
  10. Yes, that would work for objects residing in Modelspace. Though, as Stefan has noted above, be aware that the program will error with objects which do not meet the criteria for a region, so you may wish to include some error trapping to either prevent the user from selecting invalid objects, or a vl-catch-all-apply expression as used by Stefan to catch the error should an invalid object be selected. For objects residing in any space, consider the following method: (defun c:reg ( / doc ent obj ) (if (setq ent (car (entsel))) (progn (setq obj (vlax-ename->vla-object ent) doc (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-invoke (if (vlax-method-applicable-p doc 'objectidtoobject32) (vla-objectidtoobject32 doc (vla-get-ownerid32 obj)) (vla-objectidtoobject doc (vla-get-ownerid obj)) ) 'addregion (list obj) ) ) ) (princ) ) (vl-load-com)
    1 point
  11. You can alternatively use the undocumented vlax-invoke function to avoid the conversion of the object array argument to a variant: (defun c:addregion ( / i l s ) (if (setq s (ssget '((410 . "Model")))) (progn (repeat (setq i (sslength s)) (setq l (cons (vlax-ename->vla-object (ssname s (setq i (1- i)))) l)) ) (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion l) ) ) ) (vl-load-com)
    1 point
×
×
  • Create New...